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.

[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.