Sorting my Workbook!

mhenk

Well-known Member
Joined
Jun 13, 2005
Messages
591
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

tmcfadden

Board Regular
Joined
Aug 17, 2005
Messages
151
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
 

tmcfadden

Board Regular
Joined
Aug 17, 2005
Messages
151
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
Joined
Jun 13, 2005
Messages
591
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
 

tmcfadden

Board Regular
Joined
Aug 17, 2005
Messages
151
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
 

Forum statistics

Threads
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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top