Macro for SortWorksheetsByNameArray

The SortWorksheetByNameArray function sorts the worksheets in the order of the names passed as n array. While the individual elements of the array need not refer to adjacent worksheets, the worksheets, taken as a group, named by the values in the arrray, must be adjacent. You cannot sort non-adjacent sheets. The function returns True if successful or False if an error occurred. If an error occurred, the variable ErrorText will contain the text of the error message.

The declaration of SortWorksheetsByNameArray declaration is shown below:

Public Function SortWorksheetsByNameArray(NameArray() As Variant, ByRef ErrorText As String) As Boolean

NameArray is an array containing the worksheet names in the order that they should be ordered.

The code for SortWorksheetsByNameArray is shown below:

Public Function SortWorksheetsByNameArray(NameArray() As Variant, ByRef ErrorText As String) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WorksheetSortByArray
' This procedure sorts the worksheets named in NameArray to the order in
' which they appear in NameArray. The adjacent elements in NameArray need
' not be adjacent sheets, but the collection of all sheets named in
' NameArray must form a set of adjacent sheets. If successful, returns
' True and ErrorText is vbNullString. If failure, returns False and
' ErrorText contains reason for failure.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Arr() As Long
Dim N As Long
Dim M As Long
Dim L As Long
Dim WB As Workbook

ErrorText = vbNullString

'''''''''''''''''''''''''''''''''''''''''''''''
' The NameArray need not contain all of the
' worksheets in the workbook, but the sheets
' that it does name together must form a group of
' adjacent sheets. Sheets named in NameArray
' need not be adjacent in the NameArray, only
' that when all sheet taken together, they form an
' adjacent group of sheets
'''''''''''''''''''''''''''''''''''''''''''''''
ReDim Arr(LBound(NameArray) To UBound(NameArray))
On Error Resume Next
For N = LBound(NameArray) To UBound(NameArray)
    '''''''''''''''''''''''''''''''''''''''
    ' Ensure all sheets in name array exist
    '''''''''''''''''''''''''''''''''''''''
    Err.Clear
    M = Len(WB.Worksheets(NameArray(N)).Name)
    If Err.Number <> 0 Then
        ErrorText = "Worksheet does not exist."
        SortWorksheetsByNameArray = False
        Exit Function
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Put the index value of the sheet into Arr. Ensure there
    ' are no duplicates. If Arr(N) is not zero, we've already
    ' loaded that element of Arr and thus have duplicate sheet
    ' names.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Arr(N) > 0 Then
        ErrorText = "Duplicate worksheet name in NameArray."
        SortWorksheetsByNameArray = False
        Exit Function
    End If
        
    Arr(N) = Worksheets(NameArray(N)).Index
Next N

'''''''''''''''''''''''''''''''''''''''
' Sort the sheet indexes. We don't use
' these for the sorting order, but we
' do use them to ensure that the group
' of sheets passed in NameArray are
' together contiguous.
'''''''''''''''''''''''''''''''''''''''
For M = LBound(Arr) To UBound(Arr)
    For N = M To UBound(Arr)
        If Arr(N) < Arr(M) Then
            L = Arr(N)
            Arr(N) = Arr(M)
            Arr(M) = L
        End If
    Next N
Next M
''''''''''''''''''''''''''''''''''''''''
' Now that Arr is sorted ascending, ensure
' that the elements are in order differing
' by exactly 1. Otherwise, sheet are not
' adjacent.
'''''''''''''''''''''''''''''''''''''''''
If ArrayElementsInOrder(Arr:=Arr, Descending:=False, Diff:=1) = False Then
    ErrorText = "Specified sheets are not adjacent."
    SortWorksheetsByNameArray = False
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Now, do the actual move of the sheets.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo 0
WB.Worksheets(NameArray(LBound(NameArray))).Move before:=WB.Worksheets(Arr(1))
For N = LBound(NameArray) + 1 To UBound(NameArray) - 1
    WB.Worksheets(NameArray(N)).Move before:=WB.Worksheets(NameArray(N + 1))
Next N

SortWorksheetsByNameArray = True

End Function