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.
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.