Sorting Worksheets According to Region

Koen has a workbook containing 150 worksheets, one for each company branch. He needs to sort those sheets based on the region to which each branch belongs. (There are five regions in his company.) He also notes that it would be great if the tab color for each worksheet could reflect the region, and wonders if such sorting is possible in Excel.

Yes, such sorting is possible, but it does require the use of a macro. The hardest part of creating the macro is defining how you determine which branches are in which region. Perhaps the simplest way to do this is to make sure your worksheets use a naming pattern that includes both the region and branch information. For instance, you might name the worksheets something like "Reg01-Branch123." Your macro could then step through each worksheet and do both the coloring and the sorting.

Sub SortWorksheets()
    Dim iReg As Integer
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim ws As Worksheet

    Application.ScreenUpdating = False

    ' Set tab colors
    For Each ws in Worksheets
        iReg = Val(Mid(ws.Name,4,2))
        Select Case iReg
            Case 1
                ws.Tab.Color = vbRed
            Case 2
                ws.Tab.Color = vbYellow
            Case 3
                ws.Tab.Color = vbBlue
            Case 4
                ws.Tab.Color = vbGreen
            Case 5
                ws.Tab.Color = vbCyan
            Case Else
                ws.Tab.ColorIndex = xlColorIndexNone
        End Select
    Next ws

    ' Sort the worksheets
    For I = 1 To Sheets.Count - 1
        K = I
        For J = I + 1 To Sheets.Count
            If UCase(Sheets(K).Name) > UCase(Sheets(J).Name) Then K = J
        Next J
        If K <> I Then Sheets(K).Move Before:=Sheets(I)
    Next I

    Application.ScreenUpdating = True
End Sub

The macro works through the Worksheets collection twice. On the first pass through, the region number is extracted from the worksheet's name. This is then used (in the Select Case structure) to set the tab color. If the region number is outside the range of 1-5, then no change is made to the tab color.

If your determination of what branch is in what region is more complex, then you'll need to adjust the macro accordingly. For instance, you might have a worksheet named "Region Key" that contains, in column A, the names of each of your branches and, in column B, the corresponding region number for each of those branches. Assuming that the actual data begins in row 2, you could modify the macro in the following manner:

Sub SortWorksheets2()
    Dim sTemp As String
    Dim iReg As Integer
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim ws As Worksheet
    Dim key As Worksheet

    Application.ScreenUpdating = False

    Set key = Worksheets("Region Key")

    ' Set tab colors
    For Each ws in Worksheets
        sTemp = UCase(ws.Name)
        I = 2    ' Beginning row number
        iReg = 0
        While key.Cells(I, 1) > ""
            If UCase(key.Cells(I, 1)) = sTemp Then iReg = key.Cells(I, 2)
            I = I + 1
        Wend
        Select Case iReg
            Case 1
                ws.Tab.Color = vbRed
            Case 2
                ws.Tab.Color = vbYellow
            Case 3
                ws.Tab.Color = vbBlue
            Case 4
                ws.Tab.Color = vbGreen
            Case 5
                ws.Tab.Color = vbCyan
            Case Else
                ws.Tab.ColorIndex = xlColorIndexNone
        End Select
    Next ws

    ' Sort the worksheets
    For I = 1 To Sheets.Count - 1
        K = I
        For J = I + 1 To Sheets.Count
            If UCase(Sheets(K).Name) > UCase(Sheets(J).Name) Then K = J
        Next J
        If K <> I Then Sheets(K).Move Before:=Sheets(I)
    Next I
    Sheets("Region Key").Move Before:=Sheets(1)

    Application.ScreenUpdating = True
End Sub

The biggest difference between this macro and the previous one is that this one grabs the region number from a worksheet. As the last action in the macro, the "Region Key" worksheet is moved to the very beginning of the Worksheets collection.

Note that this second macro can also result in your worksheet tabs, at the bottom of the program window, looking like a kaleidoscope of colors. The reason for this is that the tabs are sorted based on their names, not on their colors. This differs from the first macro, which effectively sorted by region and then by branch because the worksheets were named using that pattern. If you want to still use the "Region Key" approach and sort by region and then branch, you can do so by adjusting the macro a bit more:

Sub SortWorksheets3()
    Dim sTemp As String
    Dim sSortArray(499) As String
    Dim iReg As Integer
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim ws As Worksheet
    Dim key As Worksheet

    Application.ScreenUpdating = False

    Set key = Worksheets("Region Key")

    ' Set tab colors and build sort array
    J = 0
    For Each ws in Worksheets
        sTemp = UCase(ws.Name)
        I = 2    ' Beginning row number
        iReg = 0
        While key.Cells(I, 1) > ""
            If UCase(key.Cells(I, 1)) = sTemp Then iReg = key.Cells(I, 2)
            I = I + 1
        Wend

        J = J + 1
        sSortArray(J) = Right("00" & iReg, 2) & " " & ws.Name

        Select Case iReg
            Case 1
                ws.Tab.Color = vbRed
            Case 2
                ws.Tab.Color = vbYellow
            Case 3
                ws.Tab.Color = vbBlue
            Case 4
                ws.Tab.Color = vbGreen
            Case 5
                ws.Tab.Color = vbCyan
            Case Else
                ws.Tab.ColorIndex = xlColorIndexNone
                ' Force into incorrect region area for sort
                sSortArray(J) = "00 " & ws.Name
        End Select
    Next ws

    ' Sort the worksheets
    For I = 1 To Sheets.Count - 1
        K = I
        For J = I + 1 To Sheets.Count
            If UCase(sSortArray(K)) > UCase(sSortArray(J)) Then K = J
        Next J
        If K <> I Then
            Sheets(K).Move Before:=Sheets(I)
            sTemp = sSortArray(K)
            For J = K To I Step -1
                sSortArray(J) = sSortArray(J-1)
            Next J
            sSortArray(I) = sTemp
        End If
    Next I
    Sheets("Region Key").Move Before:=Sheets(1)

    Application.ScreenUpdating = True
End Sub

Note that this iteration of the macro relies upon a helper array (sSortArray) to keep track of how the names in the worksheets should be sorted.

ExcelTips is your source for cost-effective Microsoft Excel training. This tip (13710) applies to Microsoft Excel 2007, 2010, 2013, 2016, 2019, 2021, 2024, and Excel in Microsoft 365.