Excel – split a spreadsheet into multiple files based on a column in Excel 2007

microsoft excelmicrosoft-excel-2007

Is there a way in Excel to split a large file into a series of smaller ones, based on the contents of a single column?

eg: I have a file of sales data for all sales reps. I need to send them a file to make corrections and send back, but I dont want to send each of them the whole file (because I dont want them changing eachother's data). The file looks something like this:

salesdata.xls

RepName          Customer        ContactEmail
Adam             Cust1           admin@cust1.com
Adam             Cust2           admin@cust2.com
Bob              Cust3           blah@cust3.com
etc...

out of this I need:

salesdata_Adam.xls

RepName          Customer        ContactEmail
Adam             Cust1           admin@cust1.com
Adam             Cust2           admin@cust2.com

and
salesdata_Bob.xls

Bob              Cust3           blah@cust3.com

Is there anything built-in to Excel 2007 to do this automatically, or should I break out the VBA?

Best Answer

As far as I know there is nothing short of a macro that going to split you data and automatically save it onto a set of files for you. VBA is probably easier.

Update I implemented my suggestion. It loops through all the names defined in the named range 'RepList'. The named range is a dynamic named range of the form =OFFSET(Names!$A$2,0,0,COUNTA(Names!$A:$A)-1,1)

module follows.

Option Explicit

'Split sales data into separate columns baed on the names defined in
'a Sales Rep List on the 'Names' sheet.
Sub SplitSalesData()
    Dim wb As Workbook
    Dim p As Range

    Application.ScreenUpdating = False

    For Each p In Sheets("Names").Range("RepList")
        Workbooks.Add
        Set wb = ActiveWorkbook
        ThisWorkbook.Activate

        WritePersonToWorkbook wb, p.Value

        wb.SaveAs ThisWorkbook.Path & "\salesdata_" & p.Value
        wb.Close
    Next p
    Application.ScreenUpdating = True
    Set wb = Nothing
End Sub

'Writes all the sales data rows belonging to a Person
'to the first sheet in the named SalesWB.
Sub WritePersonToWorkbook(ByVal SalesWB As Workbook, _
                          ByVal Person As String)
    Dim rw As Range
    Dim personRows As Range     'Stores all of the rows found
                                'containing Person in column 1
    For Each rw In UsedRange.Rows
        If Person = rw.Cells(1, 1) Then
            If personRows Is Nothing Then
                Set personRows = rw
            Else
                Set personRows = Union(personRows, rw)
            End If
        End If
    Next rw

    personRows.Copy SalesWB.Sheets(1).Cells(1, 1)
    Ser personRows = Nothing
End Sub

This workbook contains the code and the named range. The code is part of the 'Sales Data' sheet.

Related Question