Split table, based on two criteria, into separate workbooks

Hi all,

I would like to be able to automate the process of splitting up a table and saving these new tables to separate workbooks. I've been asked to do this for my manager at work, and it is a spreadsheet to track employee commissions. All commissions are being stored in the one sheet, for all months and agents, but at the end of each month we need to separate the commissions for each agent for the relevant month.

I've attached an example spreadsheet that has three columns (the actual spreadsheet records more data): A1, Organisation name; B1, Agent; and C1 Month. The required criteria is the month I need and, if possible, I'd like to have a choice of selecting a specific Agent or selecting all. For example: get the commissions for all Agents for May; or commissions for Agent Tom for June (this would be a bonus, but not essential). The code would need to split the table according to the desired criteria and then save each Agent's commissions into a new workbook with the file name format of "Agent - Month" (i.e. "Tom - May").

I use Excel 2010, but I'd like it to be compatible with 2007 as well.

I'd like to thank anyone who attempts to help me with this in advance.... Thanks.

Hi Jerry,

Thanks for that piece of code; it worked great for the test file. However, when I tried to utilise it in the actually workbook it is not working. I believe it is because the 'Agent' and 'Month' columns are in different places. In the actually spreadsheet the 'Agent' column is column D and 'Month' is at F. I changed the code to reflect these changes, but it does not work

I have also made minor edits to the save location, it now creates a new folder labelled with the month variable. I tested this within the test file, and it worked great; so I know that code is not the problem.

Would you mind helping me once again?

The code currently looks like:

Sub MakeBooks()
Dim Month As String, LR As Long, Rw As Long
Dim wsData As Worksheet, buf As String, Nms As Variant, Nm As Long

Month = Application.InputBox("What month?", "Month", "January", Type:=2)
If InStr("JanuaryFebruaryMarchAprilMayJuneJulyAugustSeptemberOctoberNovemberDecember", Month) = 0 Then
    MsgBox "That was not a month string."
    Exit Sub
End If

With Sheets("Tracker")
    On Error Resume Next
    .ShowAllData
    On Error GoTo 0
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    For Rw = 2 To LR
        If InStr(buf, .Range("B" & Rw) & ",") = 0 Then buf = buf & .Range("B" & Rw) & ","
    Next Rw

    Nms = Split(buf, ",")
    .Rows(1).AutoFilter Field:=6, Criteria1:="*" & Month & "*"
    For Nm = 0 To UBound(Nms)
        If Len(Nms(Nm)) > 0 Then
            .Rows(1).AutoFilter Field:=4, Criteria1:="*" & Nms(Nm) & "*"
            LR = .Range("A" & .Rows.Count).End(xlUp).Row
            If LR > 1 Then
                .Range("A1").CurrentRegion.Copy
                Sheets.Add
                Range("A1").PasteSpecial xlPasteAll
                ActiveSheet.Move
                Columns.AutoFit
                On Error Resume Next
                MkDir "C:\Users\Tom\Documents\Work\Test\" & Month & "\"
                On Error GoTo 0
                ActiveWorkbook.SaveAs Filename:="C:\Users\Tom\Documents\Work\Test\" & Month & "\" & Nms(Nm) & " - " & Month & ".xlsx", FileFormat:=51
                ActiveWorkbook.Close False
            End If
        End If
    Next Nm
    
    .ShowAllData
End With
    
End Sub

I've uploaded the new workbook, with my code edits in place. I appreciate all your help with this

Thanks

Fantastic!!! The code now works perfectly

Thank you for all your help with this.