Sorting worksheets in a workbook

[Mark]

I am using Excel 97 and want to sort a number of
worksheets in a workbook.

Most of the sheets have a persons name then a number in
brackets

Mark Williams (1234)
Fred Smith (1432)

Can anyone assist with some code which puts the worksheets
in order ascending order of their number, please?

Thanks in anticipation


Mark

 

[Chip Pearson]

Mark,

Try the following code:

Sub SortWorksheets()

Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
Dim Num1 As Long
Dim Num2 As Long

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
Num1 = GetNum(Worksheets(M).Name)
Num2 = GetNum(Worksheets(N).Name)
If SortDescending = True Then
If Num2 < Num1 Then
Worksheets(N).Move Before:=Worksheets(M)
End If
Else
If Num1 > Num2 Then
Worksheets(N).Move Before:=Worksheets(M)
End If
End If
Next N
Next M

End Sub

Function GetNum(S As String) As Long
Dim Pos1 As Long
Dim Pos2 As Long
Pos1 = InStr(1, S, "(")
Pos2 = InStr(1, S, ")")
GetNum = CLng(Mid(S, Pos1 + 1, Pos2 - Pos1 - 1))
End Function


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

 

[Mark]

Chip,

Wow! that is fantastic - you know what I'm going to ask
though, I have a couple of sheets that don't have any
brackets or numbers on and the code breaks on them. Is
there anyway you could tweak it a little so that it misses
those sheets out or places them at the end?

Mark

 

[Chip Pearson]

Mark,

Try the following:

Sub SortWorksheets()

Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
Dim Num1 As Long
Dim Num2 As Long
Dim WS As Worksheet

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
Num1 = GetNum(Worksheets(M).Name)
Num2 = GetNum(Worksheets(N).Name)

If Num1 >= 0 Then
If SortDescending = True Then
If Num2 < Num1 Then
Worksheets(N).Move Before:=Worksheets(M)
End If
Else
If Num1 > Num2 Then
Worksheets(N).Move Before:=Worksheets(M)
End If
End If
End If
Next N
Next M
For Each WS In Worksheets
If GetNum(WS.Name) < 0 Then
WS.Move after:=Worksheets(Worksheets.Count)
End If
Next WS

End Sub

Function GetNum(S As String) As Long
Dim Pos1 As Long
Dim Pos2 As Long
Pos1 = InStr(1, S, "(")
If Pos1 = 0 Then
GetNum = -1
Exit Function
End If
Pos2 = InStr(1, S, ")")
GetNum = CLng(Mid(S, Pos1 + 1, Pos2 - Pos1 - 1))
End Function



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

 

[Guest]

Chip,

Brilliant !

Many thanks.


Mark

-----Original Message-----
Mark,

Try the following:

Sub SortWorksheets()

Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
Dim Num1 As Long
Dim Num2 As Long
Dim WS As Worksheet

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
Num1 = GetNum(Worksheets(M).Name)
Num2 = GetNum(Worksheets(N).Name)

If Num1 >= 0 Then
If SortDescending = True Then
If Num2 < Num1 Then
Worksheets(N).Move Before:=Worksheets (M)
End If
Else
If Num1 > Num2 Then
Worksheets(N).Move Before:=Worksheets (M)
End If
End If
End If
Next N
Next M
For Each WS In Worksheets
If GetNum(WS.Name) < 0 Then
WS.Move after:=Worksheets(Worksheets.Count)
End If
Next WS

End Sub

Function GetNum(S As String) As Long
Dim Pos1 As Long
Dim Pos2 As Long
Pos1 = InStr(1, S, "(")
If Pos1 = 0 Then
GetNum = -1
Exit Function
End If
Pos2 = InStr(1, S, ")")
GetNum = CLng(Mid(S, Pos1 + 1, Pos2 - Pos1 - 1))
End Function



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com





.