Split Data on a worksheet into multiple worksheets in Excel

/, VBA/Split Data on a worksheet into multiple worksheets in Excel

Often I need to group and split the data of a worksheet into multiple worksheets, based on cell value. When there are thousands of rows to split into multiple worksheet, the task can be pretty exhaustive and time consuming.

To save myself time and for my piece of mind below is a simple VBA code I wrote to split the worksheet into multiple worksheets.

Option Explicit

'Note: Set the bFirstRowIsHeaderRow to False _
       if you don't have header row in your excel worksheet
Private Const bFirstRowIsHeaderRow As Boolean = True

Sub SplitColumnIntoWorksheets()
    Dim oActiveSheet As Worksheet
    Set oActiveSheet = ActiveSheet
    Dim iStartRow As Long
    Dim iLastRow As Long
    Dim colUniqueValues As New Collection
    Dim oNewSheet As Worksheet
    Dim sRange As String
    
    iStartRow = IIf(bFirstRowIsHeaderRow, 2, 1)
    iLastRow = GetLastRow(oActiveSheet)
    
    Dim sColumn As String
    
    sColumn = UCase(InputBox("Enter ""Key Column"" by which the data will be parsed", "Enter Key Column"))
    
    sRange = sColumn & iStartRow & ":" & sColumn & iLastRow
    
    If sColumn = "" Then GoTo ExitCode
    
    Dim oRange As Range
        
    For Each oRange In oActiveSheet.Range(sRange).Rows
        If Not oRange.Value = Empty Then
            If Not CollectionContainsKey(colUniqueValues, oRange.Value) Then
                colUniqueValues.Add CStr(oRange.Value), oRange.Value
            End If
        End If
    Next
            
    Dim varItem As Variant
    For Each varItem In colUniqueValues
        Set oNewSheet = ActiveWorkbook.Sheets.Add(After:=Worksheets(ActiveWorkbook.Sheets.Count))
        
        SetWorkSheetName oNewSheet, CStr(varItem)
        
        If bFirstRowIsHeaderRow Then oActiveSheet.Rows(1).Copy ActiveWorkbook.Sheets(oNewSheet.Index).Rows(1)
        
        oActiveSheet.Rows.AutoFilter Field:=Range(sColumn & 1).Column, Criteria1:=varItem
        oActiveSheet.Range("A" & iStartRow & ":" & sColumn & iLastRow).Copy
        oNewSheet.Range("A" & IIf(bFirstRowIsHeaderRow, 2, 1)).PasteSpecial
    Next

    oActiveSheet.Activate
    oActiveSheet.AutoFilterMode = False
    
        
ExitCode:
    Set oActiveSheet = Nothing
    Set oNewSheet = Nothing
End Sub


Public Function CollectionContainsKey(ByRef col As Collection, vKey As Variant) As Boolean
    Dim obj As Variant
    On Error GoTo ErrorHandler
    
    CollectionContainsKey = True
    obj = col(vKey)
    Exit Function
    
ErrorHandler:
    CollectionContainsKey = False
End Function

Private Function GetLastRow(ByRef oActiveSheet As Worksheet) As Long
    GetLastRow = Range("A:" & GetLastColumn(oActiveSheet, 1)).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End Function

Private Function GetLastColumn(ByRef oActiveSheet As Worksheet, iRow) As String
    GetLastColumn = GetColumnLetter(oActiveSheet.Cells(iRow, oActiveSheet.Columns.Count).End(xlToLeft).Column)
End Function

Private Function GetColumnLetter(ByVal iColumn As Long)
    Dim vArr As Variant
    
    vArr = Split(Cells(1, iColumn).Address(True, False), "$")
    GetColumnLetter = vArr(0)
End Function

Private Sub SetWorkSheetName(ByRef oWorkSheet, ByVal sName)
    Dim c As Variant
    For Each c In Array("\", "/", "*", "[", "]", ":", "?")
        sName = Replace(sName, CStr(c), "")
    Next
    oWorkSheet.Name = sName
End Sub

Note: I tend to use the Option Explicit statement to force myself to explicitly declare all the variables

To add the code to your excel file follow the below steps.
1. Press the keys ALT + F11 to open the Microsoft Visual Basic for Applications window.
2. Right click on the VBA Project you want to add the code, and click on the insert module.

Add module to VBA project

To execute the code:
1. While you are on the excel sheet press the keys ALT + F8 to open the Macro window.
2. Select the macro SplitColumnIntoWorksheets and click on Run.

Run Macro

3. In the input box and the column letter, based on the split to multiple worksheet will be performed, and click the OK button or press the Enter key.

Enter Column to Split

After you execute the macro successfully, the rows should be grouped based on the cell value and split into multiple excel worksheets in the workgroup.

Note: I tend to use Option Explicit in my VBA code to force myself to explicitly declare all the variables.

2017-03-07T20:34:24+00:00 October 20th, 2016|Excel, VBA|0 Comments

Leave A Comment