Excel VBA: Sort Sheets in Alphanumeric Order - excel

Question

I have a workbook of about 30 sheets which I am attempting to put in alphanumeric order. Ex: "New York 9, New York 10, New York 11"
My code fails to order double digit numbers after single digit ones. "10, 11, 9"
Is anyone familiar with the method for accounting for this? Many thanks!
Sub AscendingSortOfWorksheets()
'Sort worksheets in a workbook in ascending order
Dim SCount, i, j As Integer
Application.ScreenUpdating = False
SCount = Worksheets.Count
For i = 1 To SCount - 1
For j = i + 1 To SCount
If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move before:=Worksheets(i)
End If
Next j
Next i
End Sub

Answer 1

As mentioned in the comments, you need to pad the numbers with zeros, in your case single digit numbers need to be padded with 1 zero. Use this function
Function PadNumber(sName As String, lNumOfDigits As Long) As String
Dim v As Variant
Dim vPrefixList As Variant
Dim sTemp As String
Dim i As Long
' Add all other possible prefixes in this array
vPrefixList = Array("New York")
sTemp = sName
For Each v In vPrefixList
sTemp = Replace(LCase(sTemp), LCase(v), "")
Next v
sTemp = Trim(sTemp)
PadNumber = sTemp
For i = Len(sTemp) + 1 To lNumOfDigits
PadNumber = "0" & PadNumber
Next i
PadNumber = Replace(sName, sTemp, PadNumber)
End Function
Then change the line If Worksheets(j).Name < Worksheets(i).Name Then to
If PadNumber(LCase(Worksheets(j).Name), 2) < PadNumber(LCase(Worksheets(i).Name), 2) Then
Note I added LCase in the comparison. Case-sensitivity might not matter for you in this particular case but it is something you always need to keep in mind.

Answer 2

Here is one way to achieve it
Logic:
Create a 2D array to store the number after space and sheet name
Sort the array
Arrange the sheets
Code:
Sub Sample()
Dim SheetsArray() As String
'~~> Get sheet counts
Dim sheetsCount As Long: sheetsCount = ThisWorkbook.Sheets.Count
'~~> Prepare our array for input
'~~> One part will store the number and the other will store the name
ReDim SheetsArray(1 To sheetsCount, 1 To 2)
Dim ws As Worksheet
Dim tmpAr As Variant
Dim sheetNo As Long
Dim i As Long: i = 1
Dim j As Long
'~~> Loop though the worksheest
For Each ws In ThisWorkbook.Sheets
tmpAr = Split(ws.Name)
'~~> Extract last number after space
sheetNo = Trim(tmpAr(UBound(tmpAr)))
'~~> Store number and sheet name as planned
SheetsArray(i, 1) = sheetNo
SheetsArray(i, 2) = ws.Name
i = i + 1
Next ws
'~~> Sort the array on numbers
Dim TempA, TempB
For i = LBound(SheetsArray) To UBound(SheetsArray) - 1
For j = i + 1 To UBound(SheetsArray)
If SheetsArray(i, 1) > SheetsArray(j, 1) Then
TempA = SheetsArray(j, 1): TempB = SheetsArray(j, 2)
SheetsArray(j, 1) = SheetsArray(i, 1): SheetsArray(j, 2) = SheetsArray(i, 2)
SheetsArray(i, 1) = TempA: SheetsArray(i, 2) = TempB
End If
Next j
Next i
'~~> Arrange the sheets
For i = UBound(SheetsArray) To LBound(SheetsArray) Step -1
ThisWorkbook.Sheets(SheetsArray(i, 2)).Move After:=ThisWorkbook.Sheets(sheetsCount)
sheetsCount = sheetsCount - 1
Next i
End Sub
Assumptions:
The sheet names have space in their names
The sheet names are in the format New York #