Solved

# Excel VBA sort worksheets by name

Posted on 2014-09-29
308 Views
I got this below code from Microsoft, the problem is that it works to some extend but when i have the 15 Sheets in a workbook where their names  are like
Sheet1
Sheet2
Sheet3
Sheet4
Sheet5
Sheet6
Sheet7
Sheet8
Sheet9
Sheet10
Sheet11
Sheet12
Sheet13
Sheet14
Sheet15

once i run this code  after sheet1 the sheet10 gets located. where it should be Sheet2 Not Sheet10

any idea?

``````Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
If UCase\$(Sheets(j).Name) > UCase\$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
'
' If the answer is No, then sort in descending order.
'
If UCase\$(Sheets(j).Name) < UCase\$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub
``````
0
Question by:ProfessorJimJam
• 3
• 3

LVL 49

Expert Comment

ID: 40349457
Hi,

Your code sort in alphabetical order

if you want to sort sheets with name Like "Sheet" + Number

pls try

``````Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
If Mid(Sheets(j).Name, 6) * 1 > Mid(Sheets(j + 1).Name, 6) * 1 Then
Sheets(j).Move After:=Sheets(j + 1)
End If
'
' If the answer is No, then sort in descending order.
'
If Mid(Sheets(j).Name, 6) * 1 < Mid(Sheets(j + 1).Name, 6) * 1 Then
Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub
``````
Regards
0

LVL 25

Author Comment

ID: 40349466
thanks. but problem is that i used Sheet# as an example.  the sheet names does not start always with equal alphabetic character.   for example if it is Sunday1 Sunday2 Saturday1 Saturday2 and so on.
0

LVL 49

Expert Comment

ID: 40349552
pls try

``````Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
ShNameWithoutNr = fStringWithoutEndingNumber(Sheets(j).Name)
ShPlus1NameWithoutNr = fStringWithoutEndingNumber(Sheets(j + 1).Name)
ShNameEndNr = fEndingNumber(Sheets(j).Name)
ShPlus1NameEndNr = fEndingNumber(Sheets(j + 1).Name)

If ShNameWithoutNr > ShPlus1NameWithoutNr Or _
ShNameWithoutNr = ShPlus1NameWithoutNr And ShNameEndNr > ShPlus1NameEndNr Then
Sheets(j).Move After:=Sheets(j + 1)
End If
'
' If the answer is No, then sort in descending order.
'
If ShNameWithoutNr < ShPlus1NameWithoutNr Or _
ShNameWithoutNr = ShPlus1NameWithoutNr And ShNameEndNr < ShPlus1NameEndNr Then
Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub

Function fStringWithoutEndingNumber(myStr As String) As String
For Idx = Len(myStr) To 1 Step -1
If Mid(myStr, Idx, 1) Like "[0-9]" And FoundLetter <> True Then
tmp = ""
Else
tmp = Mid(myStr, Idx, 1)
FoundLetter = True
End If
Res = tmp & Res
Next
fStringWithoutEndingNumber = Res
End Function

Function fEndingNumber(myStr As String) As String
For Idx = Len(myStr) To 1 Step -1
If Mid(myStr, Idx, 1) Like "[0-9]" And FoundLetter <> True Then
tmp = Mid(myStr, Idx, 1)
Else
tmp = ""
FoundLetter = True
End If
Res = tmp & Res
Next
fEndingNumber = Res
End Function
``````
0

LVL 25

Author Comment

ID: 40349561
i tried this latest one but still Sheet10 and Sheet11 comes after Sheet1
0

LVL 49

Accepted Solution

Rgonzo1971 earned 500 total points
ID: 40349576
Small correction

``````Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
ShNameWithoutNr = fStringWithoutEndingNumber(Sheets(j).Name)
ShPlus1NameWithoutNr = fStringWithoutEndingNumber(Sheets(j + 1).Name)
ShNameEndNr = fEndingNumber(Sheets(j).Name)
ShPlus1NameEndNr = fEndingNumber(Sheets(j + 1).Name)

If ShNameWithoutNr > ShPlus1NameWithoutNr Or _
ShNameWithoutNr = ShPlus1NameWithoutNr And ShNameEndNr * 1 > ShPlus1NameEndNr * 1 Then
Sheets(j).Move After:=Sheets(j + 1)
End If
'
' If the answer is No, then sort in descending order.
'
If ShNameWithoutNr < ShPlus1NameWithoutNr Or _
ShNameWithoutNr = ShPlus1NameWithoutNr And ShNameEndNr * 1 < ShPlus1NameEndNr * 1 Then
Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub

Function fStringWithoutEndingNumber(myStr As String) As String
For Idx = Len(myStr) To 1 Step -1
If Mid(myStr, Idx, 1) Like "[0-9]" And FoundLetter <> True Then
tmp = ""
Else
tmp = Mid(myStr, Idx, 1)
FoundLetter = True
End If
Res = tmp & Res
Next
fStringWithoutEndingNumber = Res
End Function

Function fEndingNumber(myStr As String) As String
For Idx = Len(myStr) To 1 Step -1
If Mid(myStr, Idx, 1) Like "[0-9]" And FoundLetter <> True Then
tmp = Mid(myStr, Idx, 1)
Else
tmp = ""
FoundLetter = True
End If
Res = tmp & Res
Next
fEndingNumber = Res
End Function
``````
Regards
0

LVL 25

Author Comment

ID: 40349580
No Wonder, how you got the title of Genius. you are indeed Genius :-)

thanks.
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…