How to sort tabs in order of CodeName
Why can't you simply use the "<","" operators with the codenames?
(Keep in my I haven't tested it... but I'm thinking a recursive
function would simplify the code:)
Option Explicit
Option Compare Text
Function SortByCodename(WS as Worksheets) As Worksheets
Dim Done As Boolean
Done = True
For i = 1 To WS.Count - 1
If WS(i).Codename WS(i+1).Codename Then
WS(i+1).Move Befo= WS(i)
Done = False
End If
Next
If Done Then
Set SortByCodename = WS
Else
Set SortByCodename = SortByCodename( WS )
End If
End Function
Sub TestSortByCodename()
With Application
.ScreenUpdating = False
With ThisWorkbook
Set .Worksheets = SortByCodename( .Worksheets )
End With
.ScreenUpdating = True
End With
End Sub
On Jan 3, 8:56*pm, John wrote:
Looks like I found some code that will do this. In case anyone is
interested....
Sub SortSheetsCodeName()
Application.ScreenUpdating = False
Dim iSheets%, i%, j%, ws As Worksheet
iSheets = Sheets.Count
For Each ws In Worksheets
* * If Len(ws.CodeName) = 6 Then
* * For i = 1 To iSheets - 1
* * * * For j = i + 1 To iSheets
* * * * * * If Val(Right(Sheets(j).CodeName, 1)) <
Val(Right(Sheets(i).CodeName, 1)) _
* * * * * * Then Sheets(j).Move befo=Sheets(i)
* * * * Next j
* * Next i
* * End If
* * Next ws
For Each ws In Worksheets
If Len(ws.CodeName) 6 Then
For i = 1 To iSheets - 1
For j = i + 1 To iSheets
If Val(Right(Sheets(j).CodeName, 2)) < Val(Right(Sheets(i).CodeName,
2)) _
Then Sheets(j).Move befo=Sheets(i)
Next j
Next i
End If
Next ws
Application.ScreenUpdating = True
End Sub
|