Order alphabetically

[IVY440]

Another qestion for today : is there a possibility to put the different sheets into alphabetical order according to their names?

[Bob Phillips]

See http://www.cpearson.com/excel/sortws.htm

[jindon]

Hi
try the code


Sub test()
Dim a(), i As Integer, ws As Worksheet
ReDim a(1 To Sheets.Count)
For Each ws In Sheets
i = i + 1: a(i) = ws.Name
Next
QuicksortA a, LBound(a), UBound(a)
For i = LBound(a) To UBound(a)
Sheets(a(i)).Move after:=Sheets(Sheets.Count)
Next
End Sub
Sub QuicksortA(ary, LB, UB)
Dim M As Variant, temp
Dim i As Long, ii As Long, iii As Integer
i = UB
ii = LB
M = ary(Int((LB + UB) / 2))
Do While ii <= i
Do While ary(ii) < M
ii = ii + 1
Loop
Do While ary(i) > M
i = i - 1
Loop
If ii <= i Then
temp = ary(ii): ary(ii) = ary(i)
ary(i) = temp
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then QuicksortA ary, LB, i
If ii < UB Then QuicksortA ary, ii, UB
End Sub

[MWE]

Another qestion for today : is there a possibility to put the different sheets into alphabetical order according to their names?
here is a brute force approach, but it works reasonably well


Sub xlSortSheets()
' Title xlSortSheets
' Target Application: MS Excel
' Function; sorts sheets in active workbook alphbetically (A -> Z)
' NOTE: to reverse the sort, i.e., Z -> A, just reverse the sign
' in the If statement within the sorting loops
' Limitations: none
' Passed Values: none
' Public/Private Variables used: NONE
' VB/VBA procedures called:
' MATools/MWETools procedures called: NONE
' External Files Accessed: NONE
' Orig Date 30-Jul-2003
' Orig Author MWE
' HISTORY

Dim I As Integer
Dim J As Integer
Dim SheetNames() As String
Dim temp As String
' store sheet names
ReDim SheetNames(Sheets.Count)
For I = 1 To Sheets.Count
SheetNames(I) = Sheets(I).Name
Next I
' sort sheet names (A -> Z) via simple bubble sort
For I = 1 To Sheets.Count - 1
For J = I + 1 To Sheets.Count
If SheetNames(I) > SheetNames(J) Then
temp = SheetNames(I)
SheetNames(I) = SheetNames(J)
SheetNames(J) = temp
End If
Next J
Next I
' alphabetize sheets
temp = Sheets(Sheets.Count).Name
For I = Sheets.Count To 1 Step -1
Sheets(SheetNames(I)).Select
Sheets(SheetNames(I)).Move Before:=Sheets(temp)
temp = SheetNames(I)
Next I
End Sub

[jacksonworld]

This works too.


Sub SortWorksheets()
Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
SortDescending = False
If ActiveWindow.SelectedSheets.Count = 1 Then
FirstWSToSort = 1
LastWSToSort = Worksheets.Count
Else
With ActiveWindow.SelectedSheets
For N = 2 To .Count
If .Item(N - 1).Index <> .Item(N).Index - 1 Then
MsgBox "You cannot sort non-adjacent sheets"
Exit Sub
End If
Next N
FirstWSToSort = .Item(1).Index
LastWSToSort = .Item(.Count).Index
End With
End If
For M = FirstWSToSort To LastWSToSort
For N = M To LastWSToSort
If SortDescending = True Then
If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
Else
If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
End If
Next N
Next M
End Sub

[IVY440]

I tried jindon's code and I encouter new problems. There are 3 sheets which shouldn't be sorted. And also the ones with USA come before Uruguay and it should be reverse.

[Bob Phillips]

This is Chip Pearson's code that I linked you to ... it works



Sub SortWorksheets()
Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
SortDescending = False
If ActiveWindow.SelectedSheets.Count = 1 Then
FirstWSToSort = 1
LastWSToSort = Worksheets.Count
Else
With ActiveWindow.SelectedSheets
For N = 2 To .Count
If .Item(N - 1).Index <> .Item(N).Index - 1 Then
MsgBox "You cannot sort non-adjacent sheets"
Exit Sub
End If
Next N
FirstWSToSort = .Item(1).Index
LastWSToSort = .Item(.Count).Index
End With
End If
For M = FirstWSToSort To LastWSToSort
For N = M To LastWSToSort
If SortDescending = True Then
If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
Else
If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
End If
Next N
Next M
End Sub

[IVY440]

I still have the problem that the last 3 sheets which should NOT be sorted are still sorted with the rest

[jindon]

Hi
try this one


Sub test()
Dim a(), i As Integer, sn As Integer
If Sheets.Count < 4 Then Exit Sub
ReDim a(1 To Sheets.Count - 3, 1 To 2)
For sn = 1 To Sheets.Count - 3
i = i + 1: a(i, 1) = Sheets(sn).Name: a(i, 2) = UCase(Sheets(sn).Name)
Next
QuicksortA a, LBound(a), UBound(a), 2
Application.ScreenUpdating = False
For i = LBound(a) To UBound(a)
Sheets(a(i, 1)).Move after:=Sheets(Sheets.Count - 3)
Next
Application.ScreenUpdating = True
End Sub

Sub QuicksortA(ary, LB, UB, ref)
Dim M As Variant, temp
Dim i As Long, ii As Long, iii As Integer
i = UB
ii = LB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
Do While ary(ii, ref) < M
ii = ii + 1
Loop
Do While ary(i, ref) > M
i = i - 1
Loop
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii)
ary(i, iii) = temp
Next
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then QuicksortA ary, LB, i, ref
If ii < UB Then QuicksortA ary, ii, UB, ref
End Sub

[Desert Piranha]

I still have the problem that the last 3 sheets which should NOT be sorted are still sorted with the rest
Ivy,
Here is a Tab sort macro in which you can specify how many sheets you what sorted and in what order.

This help?
Dave

[IVY440]

Hi
try this one


Sub test()
Dim a(), i As Integer, sn As Integer
If Sheets.Count < 4 Then Exit Sub
ReDim a(1 To Sheets.Count - 3, 1 To 2)
For sn = 1 To Sheets.Count - 3
i = i + 1: a(i, 1) = Sheets(sn).Name: a(i, 2) = UCase(Sheets(sn).Name)
Next
QuicksortA a, LBound(a), UBound(a), 2
Application.ScreenUpdating = False
For i = LBound(a) To UBound(a)
Sheets(a(i, 1)).Move after:=Sheets(Sheets.Count - 3)
Next
Application.ScreenUpdating = True
End Sub

Sub QuicksortA(ary, LB, UB, ref)
Dim M As Variant, temp
Dim i As Long, ii As Long, iii As Integer
i = UB
ii = LB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
Do While ary(ii, ref) < M
ii = ii + 1
Loop
Do While ary(i, ref) > M
i = i - 1
Loop
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii)
ary(i, iii) = temp
Next
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then QuicksortA ary, LB, i, ref
If ii < UB Then QuicksortA ary, ii, UB, ref
End Sub


Jindon, thanx for all the help. It works perfectly like I wanted. :bow: :bow: :beerchug:

[MWE]

I tried jindon's code and I encouter new problems. There are 3 sheets which shouldn't be sorted. And also the ones with USA come before Uruguay and it should be reverse.
"USA" does come before "Uruguay" in the normal sorting process. That is because "S" comes before "r" in the ASCII code sequence. If you force the method to sort in either upper case or lower case (minor tweak to any of the methods provided), that problem will go away.