Professor J
asked on
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?
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
ASKER
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.
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
ASKER
i tried this latest one but still Sheet10 and Sheet11 comes after Sheet1
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
No Wonder, how you got the title of Genius. you are indeed Genius :-)
thanks.
thanks.
Your code sort in alphabetical order
if you want to sort sheets with name Like "Sheet" + Number
pls try
Open in new window
Regards