Sub BubbleSort(List() As String)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As String
First = LBound(List)
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If List(i) > List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub
Function FormatSheetName(strName As String, strFormat As String) As String
'E.g.: 'Table 1.1.12' --> 'Table 01.01.12'
Dim strPrefix As String, strSec1 As String, strSec2 As String, strSec3 As String
Dim strTemp As String, strArray As Variant
strPrefix = Mid(strName, 1, InStr(strName, " "))
strTemp = Mid(strName, InStr(strName, " ") + 1)
strArray = Split(strTemp, ".")
strSec1 = Format(strArray(0), strFormat)
strSec2 = Format(strArray(1), strFormat)
strSec3 = Format(strArray(2), strFormat)
FormatSheetName = strPrefix & " " & strSec1 & "." & strSec2 & "." & strSec3
End Function
Sub SortWorksheets()
Dim strArray() As String
Dim bConvertNamesToDoubleDigits As Boolean
Dim bConvertNamesToSingleDigits As Boolean
ReDim strArray(1 To ActiveWorkbook.Worksheets.Count)
'This might bog down the sort too much. If you don't use any double digit
'numbers, set this to false. If you do, set this to true to make '10' come
'after '9' and not '1'.
bConvertNamesToDoubleDigits = True
'If you converted the names to double digits for the sort, setting this to
'true will convert the names back to the way they were.
bConvertNamesToSingleDigits = True
Application.ScreenUpdating = False
If (bConvertNamesToDoubleDigits) Then
For i = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(i).Name = FormatSheetName(ActiveWorkbook.Worksheets(i).Name, "00")
Next i
End If
For i = 1 To ActiveWorkbook.Worksheets.Count
strArray(i) = ActiveWorkbook.Worksheets(i).Name
Next i
Call BubbleSort(strArray)
Worksheets(strArray(1)).Move before:=Worksheets(1)
For i = 2 To UBound(strArray) - 1
Worksheets(strArray(i)).Move after:=Worksheets(strArray(i - 1))
Next i
If (bConvertNamesToSingleDigits) Then
For i = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(i).Name = FormatSheetName(ActiveWorkbook.Worksheets(i).Name, "##")
Next i
End If
Application.ScreenUpdating = True
End Sub