macro for Group Sheets By Color

The GroupSheetsByColor function groups sheets by their tab color (available only in Excel 2002 and later). You specify in an array the colors and the order in which those colors should appear. The sheets are grouped according to those color indicators. The color indicators are the ColorIndex values, not actual RGB colors. The declaration for GroupSheetsByColor is shown below:

Public Function GroupSheetsByColor(ByVal FirstToSort As Long, ByVal LastToSort As Long, _ ByRef ErrorText As String, ColorArray() As Long) As Boolean
FirstToSort is the index (position) number of the first sheet to sort.

LastToSort is the index (position) number of the last sheet to sort. If both FirstToSort and LastSheetToSort are less than or equal to 0, all sheets are sorted.

ErrorText is a variable that will contain the error message if an error occurs.

ColorArray is an array of longs indicating the colors and order in which the sheets should be grouped.

The code is shown below:

Public Function GroupSheetsByColor(ByVal FirstToSort As Long, ByVal LastToSort As Long, _
    ByRef ErrorText As String, ColorArray() As Long) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GroupSheetsByColor
' This groups worksheets by color. The order of the colors
' to group by must be the ColorIndex values stored in
' ColorsArray.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim WB As Workbook
Dim B As Boolean
Dim N1 As Long
Dim N2 As Long
Dim N3 As Long
Dim CI1 As Long
Dim CI2 As Long
Dim CArray As Variant

Dim CNdx1 As Long
Dim Cndx2 As Long

Const MIN_COLOR_INDEX = 1
Const MAX_COLOR_INDEX = 56


If IsArrayAllocated(ColorArray) = False Then
    ErrorText = "ColorArray is not a valid, allocated array."
    GroupSheetsByColor = False
    Exit Function
End If


Set WB = Worksheets.Parent
ErrorText = vbNullString


''''''''''''''''''''''''''''''''''''''
' Setup ColorIndex array
'''''''''''''''''''''''''''''''''''''
If IsMissing(ColorArray) = False Then
    If IsArray(ColorArray) = False Then
        ErrorText = "ColorArray is not an array"
        GroupSheetsByColor = False
        Exit Function
    End If
Else
    ''''''''''''''''''''''''''''''''''''''
    ' Ensure all color indexes are valid.
    ''''''''''''''''''''''''''''''''''''''
    For N1 = LBound(ColorArray) To UBound(ColorArray)
        If (ColorArray(N1) > MAX_COLOR_INDEX) Or (ColorArray(N1) < MIN_COLOR_INDEX) Then
            ErrorText = "Invalid ColorIndex in ColorArray"
            GroupSheetsByColor = False
            Exit Function
        End If
    Next N1
End If

Set WB = Worksheets.Parent

ErrorText = vbNullString

If (FirstToSort <= 0) And (LastToSort <= 0) Then
    FirstToSort = 1
    LastToSort = WB.Worksheets.Count
End If

B = TestFirstLastSort(FirstToSort, LastToSort, ErrorText)
If B = False Then
    GroupSheetsByColor = False
    Exit Function
End If

For N1 = FirstToSort To LastToSort
    If WB.Worksheets(N1).Tab.ColorIndex = ColorArray(LBound(ColorArray)) Then
        WB.Worksheets(N1).Move before:=WB.Worksheets(1)
        Exit For
    End If
Next N1
N3 = 1
For N2 = LBound(ColorArray) To UBound(ColorArray)
    For N1 = 2 To LastToSort
        If WB.Worksheets(N1).Tab.ColorIndex = ColorArray(N2) Then
            WB.Worksheets(N1).Move after:=WB.Worksheets(N3)
            N3 = N3 + 1
        End If
        
    Next N1
Next N2

GroupSheetsByColor = True

End Function