Split file into multiple files in Excel

Question

I have the following file in Excel:

NAME VALUE
ABC 10
ABC 11
ABC 12
DEF 20
DEF 21
DEF 22
GHI 30
GHI 31
GHI 32

I'd like to split it into files by the 'Name' column (3 files for the example above) as following:

File: ABC.xsl

NAME VALUE
ABC 10
ABC 11
ABC 12

File: DEF.xsl

NAME VALUE
DEF 20
DEF 21
DEF 22

File: GHI.xsl

NAME VALUE
GHI 30
GHI 31
GHI 32

So far, tried the following macro: https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/parse-functions/sheet1-to-wbs

Got runtime errors on this line ws.Range(vTitles).AutoFilter And after commenting it out the error moved to ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm) when vCol's value became empty.

What am I doing wrong please? (as VBA isn't my strongest point atm). Any advise regarding the snippet above or an alternative code that works would be a viable solution for me.

The easiest way to "make it" would be to write a macro that does it for you ;) — , Apr 16 '14 at 10:21
@mehow If so, would it be a legitimate question to ask for one, please? — BreakPhreak, Apr 16 '14 at 10:24
It wouldn't be a legitimate question to ask us to write a macro for you. See [**how to ask**](http://stackoverflow.com/help/on-topic) and [**how to ask a good question**](http://stackoverflow.com/help/how-to-ask). — , Apr 16 '14 at 10:27
@mehow thanks for the input. ok moved on and elaborated the way I've passed through so far, is it better now please? — BreakPhreak, Apr 16 '14 at 10:33
not really, now this is becoming a troubleshooting chat which is not what SO is. You need to understand the code youre using. Use google — , Apr 16 '14 at 10:44
let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/50775/discussion-between-breakphreak-and-me-how) — BreakPhreak, Apr 16 '14 at 10:53
Sorry I have not got the extra time to help you with this... — , Apr 16 '14 at 11:01
@DanWagner sorry for delay, tried it only now! seriously, I'd buy you a beer for that, can I? — BreakPhreak, Apr 17 '14 at 13:42

score 2 · Accepted Answer · answered Apr 16 '14 at 14:56

I think this ought to get you where you're going. The code below saves each group as a workbook (.xls format) in the same directory as the workbook that houses the VBA (i.e. ThisWorkbook):

Option Explicit
Sub SplitIntoSeperateFiles()

Dim OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim FilterRange As Range
Dim UniqueNames As New Collection
Dim LastRow As Long, LastCol As Long, _
    NameCol As Long, Index As Long
Dim OutName As String

'set references and variables up-front for ease-of-use
Set DataSheet = ThisWorkbook.Worksheets("Sheet1")
NameCol = 1
LastRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set FilterRange = Range(DataSheet.Cells(1, NameCol), DataSheet.Cells(LastRow, LastCol))

'loop through the name column and store unique names in a collection
For Index = 2 To LastRow
    On Error Resume Next
        UniqueNames.Add Item:=DataSheet.Cells(Index, NameCol), Key:=DataSheet.Cells(Index, NameCol)
    On Error GoTo 0
Next Index

'iterate through the unique names collection, writing 
'to new workbooks and saving as the group name .xls
Application.DisplayAlerts = False
For Index = 1 To UniqueNames.Count
    Set OutBook = Workbooks.Add
    Set OutSheet = OutBook.Sheets(1)
    With FilterRange
        .AutoFilter Field:=NameCol, Criteria1:=UniqueNames(Index)
        .SpecialCells(xlCellTypeVisible).Copy OutSheet.Range("A1")
    End With
    OutName = ThisWorkbook.FullName
    OutName = Left(OutName, InStrRev(OutName, "\"))
    OutName = OutName & UniqueNames(Index)
    OutBook.SaveAs Filename:=OutName, FileFormat:=xlExcel8
    OutBook.Close SaveChanges:=False
    Call ClearAllFilters(DataSheet)
Next Index
Application.DisplayAlerts = True

End Sub

'safely clear all the filters on data sheet
Sub ClearAllFilters(TargetSheet As Worksheet)
    With TargetSheet
        TargetSheet.AutoFilterMode = False
        If .FilterMode Then
            .ShowAllData
        End If
    End With
End Sub

I have a subsequent question on how to make that macro reusable: http://stackoverflow.com/questions/23135211/how-to-make-a-reusable-button-from-a-macro, just FYI / followup. — BreakPhreak, Apr 17 '14 at 13:59
The macro worked great on Mac; on Windows `DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)` returns `nothing` (hence, the runtime error). Any advice please? — BreakPhreak, Apr 22 '14 at 14:05
Hmm... very interesting. Is it possible that `DataSheet` is empty? Looking at the code above, `DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row` ought to return a `Long`, not a `Range` (and `Nothing` is returned when a `Range` is missed) — Dan Wagner, Apr 22 '14 at 14:08
The `DataSheet` is not empty, moreover the following line returns a non-empty value: `DataSheet.Range("A65536").End(xlUp).Row` - but it would be wrong to assume the row limit. — BreakPhreak, Apr 22 '14 at 14:40
Very interesting indeed. I think the code I used above is in-line with the best practices for identifying last rows as outlined here: http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba — Dan Wagner, Apr 22 '14 at 15:00
Just published my answer (not marked of course) with the code that worked ok on Windows. It doesn't work on Mac, but for my case it's good enough :) — BreakPhreak, Apr 23 '14 at 16:04

score 1 · Answer 2 · answered Apr 23 '14 at 16:04

Just for the record, this code worked for me on Windows (but for some reason not on Mac):

Option Explicit
Sub SplitIntoSeparateFiles()

Dim OutBook, MyWorkbook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim FilterRange As Range
Dim UniqueNames As New Collection
Dim LastRow As Long, LastCol As Long, _
    NameCol As Long, Index As Long
Dim OutName As String

'set references and variables up-front for ease-of-use
'the current workbook is the one with the primary data, more workbooks will be created later
Set MyWorkbook = ActiveWorkbook 
Set DataSheet = ActiveSheet 'was ThisWorkbook.Worksheets("Sheet1"), now works for every sheet

NameCol = 1
LastRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'LastRow = DataSheet.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

LastCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set FilterRange = Range(DataSheet.Cells(1, NameCol), DataSheet.Cells(LastRow, LastCol))

'loop through the name column and store unique names in a collection
For Index = 2 To LastRow
    On Error Resume Next
        UniqueNames.Add Item:=DataSheet.Cells(Index, NameCol), Key:=DataSheet.Cells(Index, NameCol)
    On Error GoTo 0
Next Index

'iterate through the unique names collection, writing
'to new workbooks and saving as the group name .xls
Application.DisplayAlerts = False
For Index = 1 To UniqueNames.Count
    Set OutBook = Workbooks.Add
    Set OutSheet = OutBook.Sheets(1)
    With FilterRange
        .AutoFilter Field:=NameCol, Criteria1:=UniqueNames(Index)
        .SpecialCells(xlCellTypeVisible).Copy OutSheet.Range("A1")
    End With
    OutName = MyWorkbook.Path + "\" 'was OutName = Left(OutName, InStrRev(OutName, "\"))
                                    'the question here would be to modify the separator for every platform

    OutName = OutName & UniqueNames(Index)
    OutBook.SaveAs Filename:=OutName, FileFormat:=xlExcel8
    OutBook.Close SaveChanges:=False
    Call ClearAllFilters(DataSheet)
Next Index
Application.DisplayAlerts = True

End Sub

'safely clear all the filters on data sheet
Sub ClearAllFilters(TargetSheet As Worksheet)
    With TargetSheet
        TargetSheet.AutoFilterMode = False
        If .FilterMode Then
            .ShowAllData
        End If
    End With
End Sub

Split file into multiple files in Excel

2 Answers2

Linked