his function allows you to sort some or all worksheets based on their names, in either ascending or descending order. You also have the option of specifying whether to sort numeric sheet names as numbers or as text. For example, the following are numeric sheet names sorted as text: 11, 115, 22. Sorted as numeric, the order would be 11, 22,115. If you omit the Numeric parameter, it is treated as False and the sort will use a text value sort rather than numeric value sort. If this parameter is True, all of the sheets that are to be sorted must have a numeric name. Otherwise, the function will quit with a result of False. The function declaration is:
Public Function SortWorksheetsByName(ByVal FirstToSort As Long, ByVal LastToSort As Long, _
ByRef ErrorText As String, Optional ByVal SortDescending As Boolean = False) As Boolean FirstToSort is the index (position) of the first worksheet to sort.
LastToSort is the index (position) of the laset worksheet to sort. If either both FirstToSort and LastToSort are less than or equal to 0, all sheets in the workbook are sorted.
ErrorText is a variable that will receive the text description of any error that may occur.
SortDescending is an optional parameter to indicate that the sheets should be sorted in descending order. If True, the sort is in descending order. If omitted or False, the sort is in ascending order.
The function returns True if successful. If an error occurs, the function returns False and the variable ErrorText is set to the text of the error message.
LastToSort is the index (position) of the laset worksheet to sort. If either both FirstToSort and LastToSort are less than or equal to 0, all sheets in the workbook are sorted.
ErrorText is a variable that will receive the text description of any error that may occur.
SortDescending is an optional parameter to indicate that the sheets should be sorted in descending order. If True, the sort is in descending order. If omitted or False, the sort is in ascending order.
The function returns True if successful. If an error occurs, the function returns False and the variable ErrorText is set to the text of the error message.
The code for SortWorksheetsByName is shown below.
Public Function SortWorksheetsByName(ByVal FirstToSort As Long, _
ByVal LastToSort As Long, _
ByRef ErrorText As String, _
Optional ByVal SortDescending As Boolean = False, _
Optional ByVal Numeric As Boolean = False) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SortWorksheetsByName
' This sorts the worskheets from FirstToSort to LastToSort by name
' in either ascending (default) or descending order. If successful,
' ErrorText is vbNullString and the function returns True. If
' unsuccessful, ErrorText gets the reason why the function failed
' and the function returns False. If you include the Numeric
' parameter and it is True, (1) all sheet names to be sorted
' must be numeric, and (2) the sort compares names as numbers, not
' text.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim M As Long
Dim N As Long
Dim WB As Workbook
Dim B As Boolean
Set WB = Worksheets.Parent
ErrorText = vbNullString
If WB.ProtectStructure = True Then
ErrorText = "Workbook is protected."
SortWorksheetsByName = False
End If
'''''''''''''''''''''''''''''''''''''''''''''''
' If First and Last are both 0, sort all sheets.
''''''''''''''''''''''''''''''''''''''''''''''
If (FirstToSort = 0) And (LastToSort = 0) Then
FirstToSort = 1
LastToSort = WB.Worksheets.Count
Else
'''''''''''''''''''''''''''''''''''''''
' More than one sheet selected. We
' can sort only if the selected
' sheet are adjacent.
'''''''''''''''''''''''''''''''''''''''
B = TestFirstLastSort(FirstToSort, LastToSort, ErrorText)
If B = False Then
SortWorksheetsByName = False
Exit Function
End If
End If
If Numeric = True Then
For N = FirstToSort To LastToSort
If IsNumeric(WB.Worksheets(N).Name) = False Then
' can't sort non-numeric names
ErrorText = "Not all sheets to sort have numeric names."
SortWorksheetsByName = False
Exit Function
End If
Next N
End If
'''''''''''''''''''''''''''''''''''''''''''''
' Do the sort, essentially a Bubble Sort.
'''''''''''''''''''''''''''''''''''''''''''''
For M = FirstToSort To LastToSort
For N = M To LastToSort
If SortDescending = True Then
If Numeric = False Then
If StrComp(WB.Worksheets(N).Name, WB.Worksheets(M).Name, vbTextCompare) > 0 Then
WB.Worksheets(N).Move before:=WB.Worksheets(M)
End If
Else
If CLng(WB.Worksheets(N).Name) > CLng(WB.Worksheets(M).Name) Then
WB.Worksheets(N).Move before:=WB.Worksheets(M)
End If
End If
Else
If Numeric = False Then
If StrComp(WB.Worksheets(N).Name, WB.Worksheets(M).Name, vbTextCompare) < 0 Then
WB.Worksheets(N).Move before:=WB.Worksheets(M)
End If
Else
If CLng(WB.Worksheets(N).Name) < CLng(WB.Worksheets(M).Name) Then
WB.Worksheets(N).Move before:=WB.Worksheets(M)
End If
End If
End If
Next N
Next M
SortWorksheetsByName = True
End Function
No comments:
Post a Comment