Something that comes up time and time again in any kind of work is separating data out into separate workbooks based on the values of a field in the data.

 

How-To-Export-Your-Data-Into-Separate-Workbooks-Based-On-The-Values-In-A-Column How To Export Your Data Into Separate Workbooks Based On The Values In A Column

Get The Completed Workbook

Let’s say you have sales data for your company and you need to send each of the sales representatives in the company a copy of their sales. You might not want to share the entire set of data with each rep but just their own sales due to privacy concerns around their commission based compensation. To do this, we will need to take our original set of data and parse it out into many different workbooks (one for each sales rep) based on the sales rep column in the data.

 

Parsing and exporting data into different workbooks is a very common problem, but unfortunately Excel does not have a built in solution. We would need to manually filter for each item in a column and then copy and paste the filtered data into a new file and save that. This can be very time consuming if we have a lot of values to filter or if this is an activity we will be doing monthly, weekly or even daily. Fortunately, we can automate this with VBA!

 

This template will allow you to separate out your data by selecting a column to separate it based on. This workbook uses a table called Data to hold the aggregate data. You can adjust the size and column heading to suit your data. Delete or add columns as desired and rename the column headings to suit your own data. The drop down menu will automatically account for the new column headings. Set your save path accordingly, this is where the VBA will save all the new data files it creates. When the template is all set up, press the Run button and your new data files will appear in the save path folder.

 

The VBA uses named range references so the template is flexible and you can cut and paste the sheet until you’re satisfied and you will not break the code. Here is the VBA code used in the template.

 

Option Explicit

Sub ExportData()

'Declare variables
Dim ArrayItem As Long
Dim ws As Worksheet
Dim ArrayOfUniqueValues As Variant
Dim SavePath As String
Dim ColumnHeadingInt As Long
Dim ColumnHeadingStr As String
Dim rng As Range

'Set the worksheet to
Set ws = Sheets("Data")

'Set the save path for the files created
SavePath = Range("FolderPath")

'Set variables for the column we want to separate data based on
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Data[#Headers]"), 0)
ColumnHeadingStr = "Data[[#All],[" & Range("ExportCriteria").Value & "]]"

'Turn off screen updating to save runtime
Application.ScreenUpdating = False

'Create a temporary list of unique values from the column we want to
'separate our data based on
Range(ColumnHeadingStr & "").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Range("UniqueValues"), Unique:=True

'Sort our temporary list of unique values
ws.Range("UniqueValues").EntireColumn.Sort Key1:=ws.Range("UniqueValues").Offset(1, 0), _
    Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Add unique field values into an array
'ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(ws.Range("IV2:IV" & Rows.Count).SpecialCells(xlCellTypeConstants))
ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(ws.Range("UniqueValues").EntireColumn.SpecialCells(xlCellTypeConstants))

'Delete the temporary values
ws.Range("UniqueValues").EntireColumn.Clear

'Loop through our array of unique field values, copy paste into new workbooks and save
For ArrayItem = 1 To UBound(ArrayOfUniqueValues)
    ws.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
    ws.Range("Data[#All]").SpecialCells(xlCellTypeVisible).Copy
    Workbooks.Add
    Range("A1").PasteSpecial xlPasteAll
    ActiveWorkbook.SaveAs SavePath & ArrayOfUniqueValues(ArrayItem) & Format(Now(), " YYYY-MM-DD hhmmss") & ".xlsx", 51
    ActiveWorkbook.Close False
    ws.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt
Next ArrayItem

ws.AutoFilterMode = False
MsgBox "Finished exporting!"
Application.ScreenUpdating = True
    
End Sub

 

Note: This was tested on Excel 2016 but I have not tested it on previous versions.