Tom’s Tutorials For Excel: Parsing Data To Create and Populate Separate Workbooks

Tom’s Tutorials For Excel: Parsing Data To Create and Populate Separate Workbooks

Sometimes you need to organize a large table of data by creating and populating individual workbooks based on rows belonging to each primary subject item.

For example, the next picture shows a table of company Stores and their activities. The table is actually 50,000 rows deep. You want to create a workbook for each Store, and copy that Store’s data into its own workbook.



In the next Before-and-After pictures, the main workbook is on the C drive in a folder named YourFilePath. After the macro is run, each Store now has its own workbook with the the naming convention of the Store name, followed by an underscore, then the current date in YYYMMDD format, followed by the time in HHMMSS format. That way, you’ll be sure to keep every iteration of workbook creation as a snapshot in time, without overriding it with a same-named file.



The below macro accomplishes this task, using AdvancedFilter to create a unique list of Store names. Then, AutoFilter loops through that list to copy each Store’s data into its own workbook. As a convenience to the user, a message box pops up to confirm the job as complete, and it shows how many unique Stores were parsed.

Finally, note that the original table was not altered in any way. Here’s the macro:

Sub ParseStoresIntoWorkbooks()

'Use a With structure to prepare Excel.
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With

'Turn off autofilter and show all data.
ActiveSheet.AutoFilterMode = False
On Error Resume Next
ActiveSheet.ShowAllData
Err.Clear
With Cells
.EntireRow.Hidden = False
.EntireColumn.Hidden = False
End With

'Declare and define variables.
Dim xRow&, intCountUnique%
Dim strStore$
Dim strParsedStoreNameWB$, strDestinationFolderPath
Dim asn$, LastRow&, NextColumn&, FilterRange As Range
strDestinationFolderPath = ThisWorkbook.Path & "\"
asn = ActiveSheet.Name
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
NextColumn = Cells.Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 2
Set FilterRange = _
ThisWorkbook.Worksheets(asn).Range("A1:A" & LastRow)

'List all unique Stores using AdvancedFilter.
FilterRange.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, NextColumn), Unique:=True
'Sort the list.
Cells(1, NextColumn).CurrentRegion.Sort _
Key1:=Cells(2, NextColumn), Order1:=xlAscending, Header:=xlYes

'Count how many unique Stores there are.
intCountUnique = WorksheetFunction.CountA(Columns(NextColumn)) - 1

'Loop through all unique Stores by filtering them, paste their
'data to a new workbook, and save the workbooks with date and time.
For xRow = 2 To Cells(Rows.Count, NextColumn).End(xlUp).Row
Workbooks.Add 1
With ThisWorkbook.Worksheets(asn)
.AutoFilterMode = False
strStore = .Cells(xRow, NextColumn).Value
End With
strParsedStoreNameWB = _
strStore & "_" & Format(VBA.Now, "YYYYMMDD_HHMMSS") & ".xls"
FilterRange.AutoFilter Field:=1, Criteria1:=strStore
FilterRange.SpecialCells(12).EntireRow.Copy Range("A1")
Columns(NextColumn).Clear 'unique list
Cells.Columns.AutoFit
ActiveWorkbook.SaveAs _
Filename:=strDestinationFolderPath & strParsedStoreNameWB
ActiveWorkbook.Close
Next xRow

'Re-activate this workbook and the source worksheet.
ThisWorkbook.Activate
Sheets(asn).Activate

'Turn off autofilter and show all data.
ActiveSheet.AutoFilterMode = False
On Error Resume Next
ActiveSheet.ShowAllData
Err.Clear

'Clear the unique list.
Columns(NextColumn).Clear

'Release object variables from system menory
Set FilterRange = Nothing

'Use a With structure to reset Excel.
With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With

'Confirm for the user that the parsing is completed.
MsgBox "There were " & intCountUnique & " different Stores." & vbCrLf & _
"Their respective data has been consolidated into" & vbCrLf & _
"individual workbooks, all saved in the path" & vbCrLf & _
strDestinationFolderPath & ".", 64, "Done!"

End Sub

Share Button
Posted in Tom's Tutorials for Excel
Tags: , , , , , , , , , , , ,
16 comments on “Tom’s Tutorials For Excel: Parsing Data To Create and Populate Separate Workbooks
  1. Dan says:

    Hello,
    This worked like a charm.
    Do you have one to parse to worksheets in same workbook?
    Regards,
    Dan

  2. Pritam says:

    how this can be done using 2 columns

  3. Pritam says:

    Hi Tom,

    I mean to say, parsing data into multiple workbooks based on 2 Criterias( Column A and Column B)

    A simple example would be as below
    ColumnA ColumnB ColumnC
    Store1 East ManagerA
    Store1 East ManagerB
    Store2 East ManagerC
    Store2 West ManagerD
    Store2 West ManagerE
    Store3 North ManagerF

    The WorkBooks Should be Saved as Store1_East.xls with 2 Records,
    Store2_East.xls with 1 Records, Store1_West.xls with 2 Records, Store3_North.xls with 1 Records.

    • Tom Urtis says:

      Without writing out the code, just answering by way of theory, you can concatenate the two columns of interest in a helper column (although you can also do this in a VBA array), then filter for those unique values and carry on the macro from that point as shown in the original example.

  4. kelsye kennedy says:

    this is great …

    does anyone have a macro to parse through multiple sheets in a workbook all of which follow the same format as to the data contained therein and concatenates the data into a txt file.

    • Tom Urtis says:

      Your request is a bit vague because there are many possibilities for accomplishing this, but which approach depends on how your data is organized on each sheet (in one column or multiple columns), and if by “parse through”, you mean that some of the data will not be included and other portions will be, and if so, which portions and by what logic. Please add a few specifics so someone can help you with a suggestion that would be relevant to your situation.

  5. Mark S says:

    This is excellent.

    Is there a way to name the sheet of each new workbook?

    After running the above macro, it automatically names the sheet of the new workbooks as “Sheet1”?

    Ideally, something like “Store Data”

    Thanks

    • Tom Urtis says:

      That would be a simple modification.
      In between the lines

      Cells.Columns.AutoFit
      and
      ActiveWorkbook.SaveAs _

      enter the code line
      Activesheet.name = “Store Data”

  6. Sandeep Jha says:

    Hello I am using this code to parse data into different workbooks. But it is creating 2 workbooks for every specific data group except for the last one. Since I am new to this I am not able to sort out the issue. Can you please help me with this problem??

    • Tom Urtis says:

      I cannot duplicate your situation. As I showed in the pictures and I just tested again now, my code does not create 2 workbooks for every data group. My guess is, you have a misspelling somewhere(s) and the items you think are identical really are not. Even one small difference, such as a stray spacebar character or any other difference, no matter how small, would cause what you are seeing. Please carefully check your data again and see if that is the case.

      • Sandeep Jha says:

        Seriously there was a spacebar character issue which i just couldn’t see. That was great, now what I need is putting another set of information based on same specific data column basis in that previously created workbooks while just adding new individual worksheets.
        So instead of adding a workbook how to select several different workbooks to create 1 worksheet every time the cycle runs for storing data if it’s possible?

  7. Max Marchuk says:

    Hi Tom,

    Is there a way to do this for a workbook with multiple sheets? For example, I’ve got a workbook with 8 sheets, and each of those sheets looks slightly different, but they all share the same characteristic: They all have a column named “Team”. If I wanted to make 25 workbooks (1 for each individual team), and each workbook would have a copy of the 8 sheets with the team’s data (kinda like it’s being filtered), is there a way to do that?

    Thanks!

    • Tom Urtis says:

      Hello Max – –

      Yes, there would be a way to do this but a few details would be useful first. I see you specified 25 workbooks, so you seem to know the exact count of teams. If that number of 25 teams would ***never*** change, that would simplify things because the number is known and the team names are known. Otherwise, a few loops would be used to compile a list of team names and then re-look through the workbooks to pluck each team name in turn from where it may be among those workbooks and copy the relevant rows to their own workbook. It would help you if the source workbooks reside in a dedicated folder, and your compiled workbooks reside in their own dedicated folder. That is the basic theory of how I would go about it, but you may get different opinions on that from others. If you want someone to help you with that, an excellent & free Excel forum, which I sometimes contribute to but has experts visiting it around the clock, is at https://www.mrexcel.com/forum/excel-questions.

Leave a Reply

Your email address will not be published.

*