Excel VBA sort worksheets by name

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
Dim iAnswer As VbMsgBoxResult
'
' 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 iAnswer = vbYes Then
            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.
'
         ElseIf iAnswer = vbNo Then
            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

Open in new window

LVL 27
ProfessorJimJamAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
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
Dim iAnswer As VbMsgBoxResult
'
' 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 iAnswer = vbYes Then
            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.
'
         ElseIf iAnswer = vbNo Then
            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 

Open in new window

Regards
0
ProfessorJimJamAuthor Commented:
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
Rgonzo1971Commented:
pls try

Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
'
' 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 iAnswer = vbYes Then

            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.
'
         ElseIf iAnswer = vbNo Then
            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

Open in new window

0
Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

ProfessorJimJamAuthor Commented:
i tried this latest one but still Sheet10 and Sheet11 comes after Sheet1
0
Rgonzo1971Commented:
Small correction

Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
'
' 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 iAnswer = vbYes Then

            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.
'
         ElseIf iAnswer = vbNo Then
            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

Open in new window

Regards
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ProfessorJimJamAuthor Commented:
No Wonder, how you got the title of Genius. you are indeed Genius :-)

thanks.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.