Author: Rae Allen

I regularly get a block of data with 45 different entries in the first collum, repeated for each time a month appears in column 2. I wanted to split the data based on column value quickly and automatically

The following VBA code from extendoffice.com worked well

1. Open the Microsoft Visual Basic for Applications window. I used the Developer > Visual Basic commands from the toolbar

2. Click Insert > Module, and paste the following code in the Module Window.

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 1
Set ws = Sheets(“Sheet1”)
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = “A1:C1”
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = “Unique”
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> “” And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & “”
If Not Evaluate(“=ISREF(‘” & myarr(i) & “‘!A1)”) Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & “”
Else
Sheets(myarr(i) & “”).Move after:=Worksheets(Worksheets.Count)
End If
ws.Range(“A” & titlerow & “:A” & lr).EntireRow.Copy Sheets(myarr(i) & “”).Range(“A1”)
Sheets(myarr(i) & “”).Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

Note: In the above code:

vcol =1, the number 1 is the column number that you want to split the data based on.
Set ws = Sheets(“Sheet1”), Sheet1 is the sheet name that you want to apply this code.
title = “A1:C1”, A1:C1 is the range of the title.
All of them are variables, you can change them as your need.

3. Then press F5 key to run the code, all data in the active worksheet are split into multiple worksheets by the column value. And the split worksheets are named with the split cell names.

Note: The split worksheets are placed in the end of the workbook where the master worksheet is in.