Separating data into worksheets based on a column value


New Member
Sep 28, 2021
Office Version
  1. 2019
  1. Windows
Hi all, another beginner question. I apologize in advance for my sloppy syntax here, truly just learning and teaching myself. Basically, I needed to separate a large amount of data into separate workbooks, then based on another column within these workbooks, I need separate worksheets based on like data from that column. Then there is a bunch of code for formatting and naming, saving, etc. At the moment, the following code works (believe it or not...ha!) Now, I need to know where should I insert the code to separate into worksheets based on the value in column D. Thanks again all, you are truly amazing! :)

VBA Code:
Dim objWorksheet As Excel.Worksheet
    Dim nLastRow, nRow, nNextRow As Integer
    Dim strColumnValue As String
    Dim objDictionary As Object
    Dim varColumnValues As Variant
    Dim varColumnValue As Variant
    Dim objExcelWorkbook As Excel.Workbook
    Dim objSheet As Excel.Worksheet
    Dim Path As String

    Set objWorksheet = ActiveSheet
    nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row
    Set objDictionary = CreateObject("Scripting.Dictionary")
    Path = "H:\Accounting\Accounts Receivable\AR - Sheryl\Month End Statements\2021\"
    For nRow = 2 To nLastRow
        strColumnValue = objWorksheet.Range("A" & nRow).Value
        If objDictionary.Exists(strColumnValue) = False Then
           objDictionary.Add strColumnValue, 1
        End If
    varColumnValues = objDictionary.Keys
    For i = LBound(varColumnValues) To UBound(varColumnValues)
        varColumnValue = varColumnValues(i)
        Set objExcelWorkbook = Excel.Application.Workbooks.Add
        Set objSheet = objExcelWorkbook.Sheets(1)
        objSheet.Name = objWorksheet.Name
        For nRow = 2 To nLastRow
            If CStr(objWorksheet.Range("A" & nRow).Value) = CStr(varColumnValue) Then
               nNextRow = objSheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row + 1
               objSheet.Range("A" & nNextRow).Select

(I am assuming this is where the next bit will go, where I want to separate each new workbook into sheets based on the 'like' data in column D)
            End If
     lastrow = objSheet.Cells(Rows.Count, 11).End(xlUp).Row
     lastrow1 = objSheet.Cells(Rows.Count, 14).End(xlUp).Row
     lastrow2 = objSheet.Cells(Rows.Count, 15).End(xlUp).Row
     lastrow3 = objSheet.Cells(Rows.Count, 16).End(xlUp).Row
     lastrow4 = objSheet.Cells(Rows.Count, 17).End(xlUp).Row
     lastrow5 = objSheet.Cells(Rows.Count, 18).End(xlUp).Row
     objSheet.Range("J" & lastrow + 2) = "Total:"
     objSheet.Range("J" & lastrow + 2).Font.Bold = True
     objSheet.Range("K" & lastrow + 2).Formula = "=Sum(K2:K" & lastrow & ")"
     objSheet.Range("K" & lastrow + 2).Font.Bold = True
     objSheet.Range("K" & lastrow + 2).NumberFormat = "$#,##0.00"
     objSheet.Range("N" & lastrow1 + 2).Formula = "=Sum(N2:N" & lastrow & ")"
     objSheet.Range("N" & lastrow1 + 2).Font.Bold = True
     objSheet.Range("N" & lastrow1 + 2).NumberFormat = "$#,##0.00"
     objSheet.Range("O" & lastrow2 + 2).Formula = "=Sum(O2:O" & lastrow & ")"
     objSheet.Range("O" & lastrow2 + 2).Font.Bold = True
     objSheet.Range("O" & lastrow2 + 2).NumberFormat = "$#,##0.00"
     objSheet.Range("P" & lastrow3 + 2).Formula = "=Sum(P2:P" & lastrow & ")"
     objSheet.Range("P" & lastrow3 + 2).Font.Bold = True
     objSheet.Range("P" & lastrow3 + 2).NumberFormat = "$#,##0.00"
     objSheet.Range("Q" & lastrow4 + 2).Formula = "=Sum(Q2:Q" & lastrow & ")"
     objSheet.Range("Q" & lastrow4 + 2).Font.Bold = True
     objSheet.Range("Q" & lastrow4 + 2).NumberFormat = "$#,##0.00"
     objSheet.Range("R" & lastrow5 + 2).Formula = "=Sum(R2:R" & lastrow & ")"
     objSheet.Range("R" & lastrow5 + 2).Font.Bold = True
     objSheet.Range("R" & lastrow5 + 2).NumberFormat = "$#,##0.00"
     objSheet.Name = objSheet.Range("A2")
objExcelWorkbook.SaveAs Filename:=Path & varColumnValue & " " & objSheet.Range("B2") & " " & Format(Date, "mm.dd.yyyy") & ".xlsx", FileFormat:=xlOpenXMLWorkbook

End Sub
Last edited by a moderator:

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back