Create Sheets based on a Column

Ever felt the need of creating different sheets based on the distinct values of a column. For example, in your data, you have a column called STATE, and you would like to create a separate sheet for each state with all the data from that state. Here’s your solution then:
(Note: you’ll need to add a UDF function UniqueItems from http://j-walk.com/ss/excel/tips/tip15.htm)

This procedure will create a new sheet for each unique item in the selected column with the data from the main sheet for that unique item. As an added bonus, the procedure will sort the sheets ascending (Courtesy:ozgrid.com)
‘—————————————————————————————
‘ Procedure : CreateSheetsColumn
‘ DateTime  : 11/10/2008 09:32
‘ Author    : ARN
‘ Purpose   : To create sheets with the data from the main sheet based on a selected column.
‘Assumptions:
    ‘1 -  data are in contigious form
    ‘2 – the unique column does not have any special characters
    ‘3 – the first row is the header row
    ‘4 – the only sheet in the workbook is the data workbook
‘—————————————————————————————

Public Sub CreateSheetsColumn()

On Error GoTo CreateSheetsColumn_Error
    Dim rngInput As Range, rngColAddr As Range, varrUniqueVals() As Variant, dCounter As Double
    Dim rngCol As Range
    Dim dUniqueItems As Double, dColtoFilterOn As Double
    
    Dim lCount As Long, lShtLast As Long, lCount2 As Long
    
    ‘Set the working range
    Set rngInput = ActiveSheet.Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlLastCell))
                                    
    ‘get the column to work on from the user
    Set rngColAddr = Application.InputBox(prompt:=”Select the column that would be used to create distinct sheets”, _
                                    Title:=”Select a Column”, _
                                    Type:=8)
    ‘if more than one column is selected, exit
    If rngColAddr.Columns.Count > 1 Then
        MsgBox “Too many columns; select only one column”, vbOKOnly
        Exit Sub
    End If
    
    ‘set the application screen updating to false to increase execution speed
    Application.ScreenUpdating = False
    
    ‘store the column number in a variable
    dColtoFilterOn = rngColAddr.Column
    
    ‘set a range from the 2nd row to the last row from the selected column to get the distinct values
    Set rngCol = ActiveSheet.Range(Cells(2, dColtoFilterOn), Cells(rngInput.Rows.Count, dColtoFilterOn))
    
    ‘use the function UniqueItems (http://j-walk.com/ss/excel/tips/tip15.htm) to get unique values from the selected column
    varrUniqueVals = UniqueItems(rngCol, False)
    
    ‘get the total number of unique items
    dUniqueItems = UBound(varrUniqueVals, 1)
    
    ‘start a loop to filter the range on each unique item
    For dCounter = 1 To dUniqueItems
        ‘ only if the unique value is not blank
        If Not varrUniqueVals(dCounter) = “” Then
            ‘ apply filter
            rngInput.AutoFilter Field:=dColtoFilterOn, Criteria1:=varrUniqueVals(dCounter)
            
            ‘add a new sheet
            Sheets.Add After:=Sheets(Sheets.Count)
            
            ‘rename the sheet
            ActiveSheet.Name = varrUniqueVals(dCounter)
            
            ‘copy the filtered data
            rngInput.Copy Destination:=Worksheets(varrUniqueVals(dCounter)).Range(“A1”)
            
            ‘remove copy
            Application.CutCopyMode = False
        End If
    Next dCounter
    
    ‘remove filter
    rngInput.AutoFilter
    
    
    ‘ Sort sheets ascending – except the first one
    ‘ copied from http://www.ozgrid.com/VBA/sort-sheets.htm
    
    lShtLast = Sheets.Count
    For lCount = 2 To lShtLast
            For lCount2 = lCount To lShtLast
                If UCase(Sheets(lCount2).Name) < UCase(Sheets(lCount).Name) Then
                    Sheets(lCount2).Move Before:=Sheets(lCount)
                End If
            Next lCount2
        Next lCount
        
MsgBox “Done”

On Error GoTo 0
SmoothExit_CreateSheetsColumn:

    Application.ScreenUpdating = True

    Exit Sub

CreateSheetsColumn_Error:
    MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in Sub:CreateSheetsColumn”
    Resume SmoothExit_CreateSheetsColumn
End Sub

About the Author

The author of Tableau Data Visualization Cookbook and an award winning keynote speaker, Ashutosh R. Nandeshwar is one of the few analytics professionals in the higher education industry who has developed analytical solutions for all stages of the student life cycle (from recruitment to giving). He enjoys speaking about the power of data, as well as ranting about data professionals who chase after “interesting” things. He earned his PhD/MS from West Virginia University and his BEng from Nagpur University, all in industrial engineering. Currently, he is leading the data science, reporting, and prospect development efforts at the University of Southern California.

Leave a Reply 0 comments