J
jnf40
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 Before:=Worksheets(M)
End If
Else
If Not bGreater Then
Worksheets(N).Move Before:=Worksheets(M)
End If
End If
Next N
Next M
End Sub
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 Before:=Worksheets(M)
End If
Else
If Not bGreater Then
Worksheets(N).Move Before:=Worksheets(M)
End If
End If
Next N
Next M
End Sub