Sort Worksheet by Color VBA

**Admin** · 10-25-2011, 02:25 AM

Hi All,

Here is routine to sort the worksheets by tab color

Code:

Sub SortWorksheetsByColor(Optional ByVal SortByAsc As Boolean = True)
    
    Dim i           As Long
    Dim j           As Long
    Dim ShtC()      As Long
    Dim ShtN()      As String
    Dim t, n        As Long
    Dim lngSU       As Long
    
    'Developed by Kris @ ExcelFox.com
    'Works XL 2002 or later(Tested only 2007)
    
    With Application
        lngSU = .ScreenUpdating
        .ScreenUpdating = False
    End With
    
    If Val(Application.Version) >= 10 Then
        With ThisWorkbook
            For i = 1 To .Worksheets.Count
                If .Worksheets(i).Visible = -1 Then
                    n = n + 1
                    ReDim Preserve ShtC(1 To n)
                    ReDim Preserve ShtN(1 To n)
                    ShtC(n) = .Worksheets(i).Tab.Color
                    ShtN(n) = .Worksheets(i).Name
                End If
            Next
            For i = 1 To n
                For j = i To n
                    If ShtC(j) < ShtC(i) Then
                        t = ShtN(i)
                        ShtN(i) = ShtN(j)
                        ShtN(j) = t
                        t = ShtC(i)
                        ShtC(i) = ShtC(j)
                        ShtC(j) = t
                    End If
                Next
            Next
            If SortByAsc Then
                For i = n To 1 Step -1
                    .Worksheets(CStr(ShtN(i))).Move before:=.Worksheets(1)
                Next
            Else
                For i = n To 1 Step -1
                    .Worksheets(CStr(ShtN(i))).Move after:=.Worksheets(.Worksheets.Count)
                Next
            End If
        End With
    End If
    
    Application.ScreenUpdating = lngSU
    
End Sub

Call the routine like

For ascending

Code: