Sorting worksheets by name AND colour

[Porky79]

Hi Guys - I am looking to use the below code listed by Padgett back
in 2004 to order my worksheets alphetically. However I am wondering if
it is possible to modify so that it groups worksheets by colour and
then sorts them alphetibically - to explain I am colour coding pink
for girls and blue for boys and I want the code to result in having
all boys worksheets grouped and sorted alphabetically followed by the
girls grouped and sorted.

Any assistance would be great

Thanks

Paul



Sub SortWorksheets()

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


SortDescending = False
FirstWSToSort = 2
LastWSToSort = Worksheets.Count


For M = FirstWSToSort To LastWSToSort
For N = M To LastWSToSort
If SortDescending = True Then
If UCase(Worksheets(N).Name) > _
UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
Else
If UCase(Worksheets(N).Name) < _
UCase(Worksheets(M).Name) Then
Worksheets(N).Move Before:=Worksheets(M)
End If
End If
Next N
Next M


End Sub


*******************************************
As written above, the code will sort all of the worksheets in
ascending
order. To sort in descending order, you can change SortDescending
to
True. You may not want to sort all of the sheets. For example, if
you have a summary sheet at either the beginning or end of the
workbook, you may not want to include this in the sort. To start the
sort after the one or more sheets, change the value of FirstWSToSort
to
the index number of the first worksheet to sort. For example, to
leave
the first two worksheets in place, change the value to 3. Similarly,
to leave the last two sheets in place, change the value of
LastWSToSort
to Worksheets.Count.
If you don't know what the worksheet index number is, or you want to
use the worksheet name instead of the index number, you can retrieve
the sheet's index number with the Index property. For example,
FirstWSToSort = Worksheets("SomeSheet").Index

 

[Nigel]

You can utilise the read/write property Tab.Color to organise the sheets.

Where UCase(Worksheets(N).Name) and UCase(Worksheets(M).Name) are used in
your code replace with

Worksheets(N).Tab.Color and Worksheets(M).Tab.Color respectively.

 

[Porky79]

Thanks - however the adjustment just sorts the work sheets into groups
of teh same colour. In addition I am looking to have the names in each
colour group to be ordered alphebetically i.e. Blue tabs sorted a-z
followed by pink tabs sorted a-z

Thanks for the help

 

[Eric G]

Your original sorting code can be found on Chip Pearson's web site:

http://www.cpearson.com/excel/sortws.htm

On this same page he has additional code to group tabs by color. All you
have to do is first sort the way you already are, then use the additional
code to group the sorted tabs by color.

HTH,

Eric

 

[Eric G]

Oops - that didn't work for my test case. I have six tabs - "A", "B", "C",
"D", "E", and "F". "A" and "E" are Red, "B", "C", and "D" are Blue and "F"
is Yellow. The first sort works - I get the right order after randomly
moving the tabs around. Then when I grouped by tab color, I get "A" and "E"
(the Red tabs), "B", "D", and "C" (the Blue tabs) and "F" (the Yellow tab).
The Blue tabs are not in the correct order.

Chip - if you notice this post, please let us know why this test case didn't
work.

Thanks,

Eric

 

[Eric G]

Never mind - looks like I included an old page reference. The latest
reference is below. I have not tested that code, but I'll give it a try.

http://www.cpearson.com/excel/sortws.aspx

Eric

 

[Eric G]

If you download Chip's ".bas" module and insert it into your workbook, all
you have to do is replace the test subroutine he has in there with this one
to get the worksheets to sort by alpha order and then group by color. It
worked on my test case.

Sub SortTheSheets()
Dim B As Boolean
Dim S As String
' sort using all default values = all sheets in ascending order by name.
B = SortWorksheetsByName(0, 0, S, False)
If B = True Then
MsgBox "Worksheets Sorted"
Else
MsgBox "Error sorting sheets: " & S
End If
'
' Find all unique color indices in the worksheet tab colors
'
Dim i As Long, j As Long
Dim tabColors() As Long
Dim nColors As Long
Dim newColor As Boolean
nColors = 0
For i = 1 To ActiveWorkbook.Worksheets.Count
newColor = True
For j = 1 To nColors
If (tabColors(j) = ActiveWorkbook.Worksheets(i).Tab.ColorIndex)
Then
newColor = False
Exit For
End If
Next j
If (newColor) Then
nColors = nColors + 1
ReDim Preserve tabColors(nColors)
tabColors(nColors) = ActiveWorkbook.Worksheets(i).Tab.ColorIndex
End If
Next i
'
' Now group the tabs by colorindex
'
B = GroupSheetsByColor(1, ActiveWorkbook.Worksheets.Count, S, tabColors)
'
If B = True Then
MsgBox "Worksheets Grouped by ColorIndex"
Else
MsgBox "Error grouping sheets: " & S
End If
'
End Sub

Sorry for the multiple posts...

Eric