VBA: Splitting excel file up based on a category in the data

Question

In essence we want to create a VBA code that automatically creates Workbooks for each type of store (a column/variable in our dataset).

As an example, we have one source workbook with the following table:

Store   Seller    Item     Price
 A    | Youtube | Banana | 5,00 
 B    | Youtube | Apple  | 6,00 
 A    | Google  | Apple  | 7,00 
 C    | Google  | Pear   | 5,00 
 B    | Amazon  | Citron | 4,50

What we want to achieve with the VBA code for the table above is three separate workbooks for Type of store A, B and C. The workbook needs to have the name of the Type of store. So it would look like:

~ A.xls ~
Store   Seller    Item     Price
 A    | Youtube | Banana | 5,00
 A    | Google  | Apple  | 7,00

~ B.xls ~
Store   Seller    Item     Price
 B    | Youtube | Apple  | 6,00 
 B    | Amazon  | Citron | 4,50 

~ C.xls ~
Store   Seller    Item    Price
 C    | Google  | Pear   | 5,00

I had a go with a very crude way of doing it (see below) but there are a few things missing:

An efficient loop
The Windows(“Map4”).Activate messes up a potential loop
And a way of naming the file according to the ‘Type of store’

Sub Macro1() 

    ActiveSheet.Range("$A$1:$A$8" & "$C$1:$C$8").AutoFilter Field:=2, 
    Criteria1:="aa"
    Workbooks.Add 

    Windows("Test_split file.xlsm").Activate 
    Range("A1:C8").Select 
    Selection.Copy 
    Windows("Map4").Activate 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 

    ActiveWorkbook.SaveAs Filename:="C:\Users\bjprent\Documents\aa.xlsx", _ 
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 
    ActiveWindow.Close 


    ActiveSheet.Range("$A$1:$C$8").AutoFilter Field:=2, Criteria1:="bb" 
    Workbooks.Add

    Windows("Test_split file.xlsx").Activate 
    Range("A1:C8").Select 
    Selection.Copy 
    Windows("Map4").Activate 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 

    ActiveWorkbook.SaveAs Filename:="C:\Users\bjprent\Documents\bb.xlsx", _ 
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 
    ActiveWindow.Close 

End Sub

Thanks in advance for any help! :)

You really shouldn't use `.Select` or `.Activate` at all in your code https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — Marcucciboy2, Sep 13 '18 at 14:46
Is there a particular reason you're trying to use Excel as a database? Use an actual database (like Access) you'll find this much easier. — FreeMan, Sep 13 '18 at 14:57
Thanks for the good question! I am working in a company with a large (gigantic actually) database and this is just a pilot we are running away from the proper day-to-day systems, hence; the excel way of doing it.. When we are done with our pilot the idea is to build this into the proper database system (an Oracle environment) properly. — Natalie de Vries, Sep 14 '18 at 06:43

score 2 · Answer 1 · answered Sep 13 '18 at 15:08

2

This is how to manually do this:

Create a pivot table
Drag Type of store to the Filters (page field) area
Drag Seller and Item to the rowfield area
Drag Price to the Values area
Now click on the "Analyze" tab of the ribbon and choose "Options", "Show Report Filter Pages".
Select Type of Store and click OK.

answered Sep 13 '18 at 15:08

jkpieterse

2,727
1
9
18

Thanks! We have done some things with pivot tables so far but it will be a very large dataset and I want to be able to do this many times over so an automatic loop will be easier. :) – Natalie de Vries Sep 14 '18 at 06:55

score 1 · Answer 2 · answered Sep 13 '18 at 15:13

Details as comments within.

Sub splitStores()

    Dim i As Long, k As Variant, stores As Object

    Set stores = CreateObject("scripting.dictionary")
    stores.comparemode = vbTextCompare

    With ThisWorkbook.Worksheets("sheet9")
        If .AutoFilterMode Then .AutoFilterMode = False

        'create unique list of stores
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            stores.Item(.Cells(i, "A").Value2) = vbNullString
        Next i

        'cycle through the stores
        For Each k In stores.keys

            'create a new active workbook with all records
            .Cells.Parent.Copy

            With ActiveWorkbook.Worksheets(1)

                'rename the worksheet
                .Name = k

                'setup the autofilter area
                With .Cells(1, 1).CurrentRegion

                    'filter to show anything but current store
                    .AutoFilter field:=1, Criteria1:="<>" & k

                    'delete all unrelated records
                    .Offset(1, 0).EntireRow.Delete

                    'turn filter off
                    .Parent.AutoFilterMode = False

                End With

                'save and close independent workbook
                .Parent.SaveAs Filename:=ThisWorkbook.Path & "\" & k, FileFormat:=xlOpenXMLWorkbook
                .Parent.Close savechanges:=False

            End With

        Next k

    End With
End Sub

VBA: Splitting excel file up based on a category in the data

2 Answers2