how to sort worksheets

J

jnf40

I have tried Chip Pearson's sorting codes and I can't get it to work on my
worksheet names, maybe it can't be done... My worksheet names are created by
code...the names are as follows:
01-01-06 CSB 18" RCP; 01-01-06 CSB 18" RCP (2); 12-01-05 CSB 18" RCP
after the sort I would like the order to be:
12-01-05 CSB 18" RCP; 01-01-06 CSB 18" RCP; 01-01-06 CSB 18" RCP (2)...
Can this be done?
 
T

Tom Ogilvy

That sort magic is all in the comparison of the names to each other.

You will need to modify Pearson's code to do a different type of comparison

Extract the first 8 characters from the name and convert that to a date.
then compare the dates

if they match, then compare the remainder.
 
D

Dave Peterson

Another option would be to rename your existing worksheets using a format like:

yyyy-mm-dd XXX ###" XXX

You may want to make sure that the inches portion includes enough characters for
the worse case scenario:

So for example:
2006-01-28 CSB 001" RCP
 
J

jnf40

Thanks for the response...you make it sound so easy, but I'm not that good
with vba to know where to begin with that.
 
T

Tom Ogilvy

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top