Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Excel VBA sort worksheets by name

Posted on 2014-09-29
6
Medium Priority
?
361 Views
Last Modified: 2014-09-29
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

0
Comment
Question by:ProfessorJimJam
  • 3
  • 3
6 Comments
 
LVL 53

Expert Comment

by:Rgonzo1971
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
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
 
LVL 27

Author Comment

by:ProfessorJimJam
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 53

Expert Comment

by:Rgonzo1971
ID: 40349552
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 27

Author Comment

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

Accepted Solution

by:
Rgonzo1971 earned 2000 total points
ID: 40349576
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
 
LVL 27

Author Comment

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

thanks.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

971 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question