# Sorting my Workbook!

#### mhenk

##### Well-known Member
I have a large workbook, of about 1200 worksheets, all named:

Table X.Y.Z

I would like to write a macro to sort the tables by X, then by Y, then by Z, so my tables would be sorted as:

Table 1.1.1
Table 1.1.2
Table 1.2.1
Table 1.2.2
...
Table 4.1.1
Table 4.1.2
Table 4.1.3
Table 4.2.1

etc.

Any help would be appreciated!

### Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

##### Board Regular
The following BubbleSort algorithm was taken from http://www.lacher.com/examples/lacher17.htm

Try this code:
Code:
``````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

Sub SortWorksheets()
Dim strArray() As String
ReDim strArray(1 To ActiveWorkbook.Worksheets.Count)

For i = 1 To ActiveWorkbook.Worksheets.Count
strArray(i) = ActiveWorkbook.Worksheets(i).Name
Next i

Call BubbleSort(strArray)

Application.ScreenUpdating = False
For i = 1 To UBound(strArray) - 1
Worksheets(strArray(i)).Move before:=Worksheets(strArray(i + 1))
Next i
Application.ScreenUpdating = True

End Sub``````

It might be pretty slow.

-Tim

##### Board Regular
Even better. This one accounts for two digit sheetnames.
Code:
``````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``````

-Tim

#### mhenk

##### Well-known Member
I haven't had a chance to test either of these, but just to be sure, will either of them work for larger than 2 digit sheet names?

I go up to Table 4.161.3

##### Board Regular
No, it wouldn't sort right. That'll teach me for not being proactive!

Anyway, it's a simple change. The code will now go up to 4 digits! Yipee! Of course, I pitty anyone who would need to use 4 digits.

Here's the new version of the code:
Code:
``````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 bConvertNamesToFourDigits 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'.
bConvertNamesToFourDigits = 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 (bConvertNamesToFourDigits) Then
For i = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(i).Name = FormatSheetName(ActiveWorkbook.Worksheets(i).Name, "0000")
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``````

-Tim

Replies
5
Views
554
Replies
0
Views
73
Replies
0
Views
223
Replies
5
Views
588
Replies
0
Views
98

1,136,597
Messages
5,676,719
Members
419,647
Latest member
usas12gthr

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back