ExcelBanter - sorting worksheets new problem

I love to modify Tom's code. he it the expert and I always learn from
working with his code

Sub sortsheets()

Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
Dim bGreater As Boolean

SortDescending = False

If ActiveWindow.SelectedSheets.Count = 1 Then
FirstWSToSort = 1
LastWSToSort = Worksheets.Count
Else
With ActiveWindow.SelectedSheets
For N = 2 To .Count
If .Item(N - 1).Index < .Item(N).Index - 1 Then
MsgBox "You cannot sort non-adjacent sheets"
Exit Sub
End If
Next N
FirstWSToSort = .Item(1).Index
LastWSToSort = .Item(.Count).Index
End With
End If

For M = FirstWSToSort To (LastWSToSort - 1)
For N = (M + 1) To LastWSToSort
sN = Worksheets(N).Name
sM = Worksheets(M).Name
dtN = CDate(Left(sN, 8))
dtM = CDate(Left(sM, 8))

sN1 = Right(sN, Len(sN) - 8)
sM1 = Right(sM, Len(sM) - 8)

'Extract version number
If InStr(sN1, "(") 0 Then
VerStr = Mid(sN1, InStr(sN1, "(") + 1)
VerStr = Left(VerStr, InStr(VerStr, ")") - 1)

VerNumN = CInt(VerStr)
sN1 = Left(sN1, InStr(sN1, ")") - 2)
Else
VerNumN = 0
End If

If InStr(sM1, "(") 0 Then
VerStr = Mid(sM1, InStr(sM1, "(") + 1)
VerStr = Left(VerStr, InStr(VerStr, ")") - 1)

VerNumM = CInt(VerStr)
sM1 = Left(sM1, InStr(sM1, ")") - 2)

Else
VerNumM = 0
End If

If dtN dtM Then
bGreater = True
ElseIf dtN < dtM Then
bGreater = False
Else
If StrComp(sN1, sM1, vbTextCompare) = 0 Then
If StrComp(sN1, sM1, vbTextCompare) = 0 Then
If VerNumN VerNumM Then
bGreater = True
Else
bGreater = False
End If
Else
bGreater = True
End If
Else
bGreater = False
End If
End If
If SortDescending = True Then
If bGreater Then
Worksheets(N).Move Befo=Worksheets(M)
End If
Else
If Not bGreater Then
Worksheets(N).Move Befo=Worksheets(M)
End If
End If
Next N
Next M

End Sub

"jnf40" wrote:

Hi, I had a post 09/28/06 "how to sort worksheets" and the code you provided
worked great until recently. Here is the new problem:
01-01-06 CSB 18" RCP; 01-01-06 CSB 18" RCP (2); 01-01-06 CSB 18" RCP (3);
through 01-01-06 CSB 18" RCP (10)
when your code runs and it sorts the sheets they end up
01-01-06 CSB 18" RCP; 01-01-06 CSB 18" RCP (10);01-01-06 CSB 18" RCP (2);
01-01-06 CSB 18" RCP (3)
after the sort I would like the order to be:
01-01-06 CSB 18" RCP; 01-01-06 CSB 18" RCP (2); 01-01-06 CSB 18" RCP (3);
through 01-01-06 CSB 18" RCP (10)
Can this be done?

The code you provided is:

This modification of Chip's code worked for me with your samples.

Sub SortWorksheets()

Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
Dim bGreater As Boolean

SortDescending = False

If ActiveWindow.SelectedSheets.Count = 1 Then
FirstWSToSort = 1
LastWSToSort = Worksheets.Count
Else
With ActiveWindow.SelectedSheets
For N = 2 To .Count
If .Item(N - 1).Index < .Item(N).Index - 1 Then
MsgBox "You cannot sort non-adjacent sheets"
Exit Sub
End If
Next N
FirstWSToSort = .Item(1).Index
LastWSToSort = .Item(.Count).Index
End With
End If

For M = FirstWSToSort To LastWSToSort
For N = M To LastWSToSort
sN = Worksheets(N).Name
sM = Worksheets(M).Name
dtN = CDate(Left(sN, 8))
dtM = CDate(Left(sM, 8))
sN1 = Right(sN, Len(sN) - 8)
sM1 = Right(sM, Len(sM) - 8)
If dtN dtM Then
bGreater = True
ElseIf dtN < dtM Then
bGreater = False
Else
If StrComp(sN1, sM1, vbTextCompare) = 0 Then
bGreater = True
Else
bGreater = False
End If
End If
If SortDescending = True Then
If bGreater Then
Worksheets(N).Move Befo=Worksheets(M)
End If
Else
If Not bGreater Then
Worksheets(N).Move Befo=Worksheets(M)
End If
End If
Next N
Next M

End Sub

--
Regards,
Tom Ogilvy