22 November 2021

How to Divide Data Into Separate Excel Workbooks Using VBA

Suppose you need to apply a filter on a column and paste each filtered table into a separate Excel workbook until all unique values have been filtered and pasted. This can be a very time-consuming process, especially if there are many rows on the Excel master workbook. However, it can be easily and quickly completed using Excel VBA. In this article, I will explain how to use VBA to divide data from the master workbook into separate Excel workbooks based on the different filtered values. For demonstration purposes, I will be using the Athletes dataset from Kaggle that contains all the athletes from the 2021 Japan Olympics. The steps are as follows:

Step 1. Create a List of Unique Values

Find an empty column and type “=UNIQUE” in an empty cell. Then, select the entire column that will be filtered. Next, press “Shift + Enter.” This way, you will have a list of unique values from the column that will be filtered. I used column E as my empty column to list all the unique values from the “Discipline” column which will be filtered.

Step 2. Write VBA Code

You can find the “Developer” tab on the top ribbon of Excel. On the “Developer” tab, you can find “Visual Basic.” Once you click “Visual Basic,” there will be a drop-down menu on the top left of the new screen where you can find “Module.” Once you click this, it opens the VBA editor. Alternatively, you can press “Alt + F11” to open the VBA editor. Then, you can write the following code in the VBA editor:

Sub FilterSeperateIntoWorkbooks()
 
'Declare all the variables
Dim currRow As Integer
Dim i As Integer
Dim Names As String
        
'Turn off screen updating
Application.ScreenUpdating = False
   
'Use a “while loop” to loop through unique “discipline names” that we generated in column E, starting from the cell “E1.” For example, in the first loop, we get “Cycling Road” as the “Name”
i = 1
While Range("E" & i) <> ""
Range("E" & i).Activate
Names = Range("E" & i).Value
   
'Add a new workbook
Workbooks.Add
   
'Save the workbook using the Names variable above
ActiveWorkbook.SaveAs (Names)
   
'Activate the MasterFile
Workbooks("MasterFile.xlsm").Activate
   
'Activate the MasterSheet
Sheets("MasterSheet").Activate
        
'Apply filter to the table. Our filtered column is the third one from the left, which is why the Field is equal to 3, and the criteria is based on the “Name” we obtained above. In this case, the Name in the First loop is “Cycling Road”
ActiveSheet.Range("C1").AutoFilter _
Field:=3, _
Criteria1:=Names, _
VisibleDropDown:=True
        
'Once the filter is applied based on “Cycling Road,” we should get the last row number of the filtered table
currRow = Range("A1").End(xlDown).Row
     
'Copy the range specified below
Range(Cells(1, "A"), Cells(currRow, "C")).Copy
        
'Once you’ve copied the data, activate the new workbook mentioned above
Workbooks(Names & ".xlsx").Activate
            
'Paste the data, auto adjust the column width, and select the cell “A1”
Range("A1").PasteSpecial (xlPasteAllUsingSourceTheme)
Range("A:C").EntireColumn.AutoFit
Range("A1").Select
           
'Save and Close the workbook
ActiveWorkbook.Save
ActiveWorkbook.Close
   
'Activate the MasterFile
Workbooks("MasterFile.xlsm").Activate
'Activate the MasterSheet
Sheets("MasterSheet").Activate
             
'Unfilter the table
If ActiveSheet.FilterMode = True Then
Sheets("MasterSheet").ShowAllData
End If
        
'Increment i, so we can start our second loop and filter by “Artistic Gymnastics.” It will repeat the same steps listed above, starting from While Range("E" & i) <> ""
i = i + 1
             
'Once the condition Range("E" & i) <> "" in the while loop becomes false, we exit our loop
Wend
   
'Once the program is finished, turn on the screen updating
Application.ScreenUpdating = True
       
'End program
End Sub

The result of the code above looks like this:

This code has come in handy for me countless times when I needed to split data based on certain criteria and send certain categories of data to different people. Hopefully, it’s equally useful to you!