'----------------------------------------------------
 ' Sheet1 code module
 '----------------------------------------------------
 ' Function:     Procedures to respond to the buttons
 '               on the demo worksheet
 '               cmdSortCell
 '                   calls the sort procedure for cell
 '                   colour
 '               cmdSortText
 '                   calls the sort procedure for text
 '                   colour
 '               cmdCellReset
 '                   resorts the cell colour data to
 '                   start point
 '               cmdSortText
 '                   resorts the text colour data to
 '                   start point
 '----------------------------------------------------
Option Explicit 
 
Private Sub cmdCellReset_Click() 
    Range("C6:D14").Sort Key1:=Range("D6"), _ 
    Order1:=xlAscending, _ 
    Header:=xlNo, _ 
    OrderCustom:=1, _ 
    MatchCase:=False, _ 
    Orientation:=xlTopToBottom 
    Range("B2").Select 
End Sub 
 
Private Sub cmdTextReset_Click() 
    Range("H6:I14").Sort Key1:=Range("I6"), _ 
    Order1:=xlAscending, _ 
    Header:=xlNo, _ 
    OrderCustom:=1, _ 
    MatchCase:=False, _ 
    Orientation:=xlTopToBottom 
    Range("B2").Select 
End Sub 
 
Private Sub cmdSortCell_Click() 
    SortByColour Range("C6:D14"), Range("C6") 
End Sub 
 
Private Sub cmdSortText_Click() 
    SortByColour Range("H6:I14"), Range("H6"), False 
End Sub 
 
 '----------------------------------------------------
 ' End of Sheet1 code module
 '----------------------------------------------------
 
 
 
 
 '----------------------------------------------------
 ' mSortByColour code module
 '----------------------------------------------------
 ' Function:     Sorts the range by colour
 ' Arguments:    SortData
 '                   the range to sort
 '               ByCell
 '                   True to sort cell colour,
 '                   False to sort text colour
 '               Key1
 '                   First sort field as Range object
 '               Order1
 '                   1 or 2 for ascending/descending
 '               Key2
 '                   Second sort field as Range object
 '               Order2
 '                   1 or 2 for ascending/descending
 '               Key3
 '                   Third sort field as Range object
 '               Order3
 '                   1 or 2 for ascending/descending
 '               Header
 '                   1 or 2 for yes/no
 '----------------------------------------------------
Option Explicit 
 
Sub SortByColour(SortData As Range, _ 
    Key1 As Range, _ 
    Optional ByCell As Boolean = True, _ 
    Optional Order1 = xlAscending, _ 
    Optional Key2 As Range, _ 
    Optional Order2 = xlAscending, _ 
    Optional Key3 As Range, _ 
    Optional Order3 = xlAscending, _ 
    Optional Header = xlNo) 
    Dim cell As Range 
    Dim rngData As Range 
    Dim rngToSort As Range 
    Dim rngKey1 As Range 
     
     'stop screen flashing
    Application.ScreenUpdating = False 
     
     'insert a helper column to insert calculated colorindex
     'and set the primary sort key to first cell in that range
    Key1.Cells(1, 2).EntireColumn.Insert 
    Set rngKey1 = Key1.Cells(1, 2) 
     
     'setup the sort range, including or excluding the header row
    If Header = xlYes Then 
        Set rngData = Key1.Cells(2, 1).Resize(SortData.Rows.Count, 1) 
    Else 
        Set rngData = Key1.Cells(1, 1).Resize(SortData.Rows.Count, 1) 
    End If 
     
     'calculate the colorindex for each cell in the sort range
     'checking if we need to get cell colour or text colour
    For Each cell In rngData 
        cell.Offset(0, 1).Value = IIf(ByCell, cell.Interior.ColorIndex, cell.Font.ColorIndex) 
    Next cell 
     
     'now sort the data on the primary key supplied, and key2 and key3 if
     'applicable
    Select Case True 
Case Not Key2 Is Nothing And Not Key3 Is Nothing: 
        SortData.Sort Key1:=rngKey1, _ 
        Order1:=Order2, _ 
        Key2:=Key2, _ 
        Order2:=Order2, _ 
        Key3:=Key3, _ 
        Order3:=Order3, _ 
        Header:=Header 
Case Not Key2 Is Nothing: 
        SortData.Sort Key1:=rngKey1, _ 
        Order1:=Order2, _ 
        Key2:=Key2, _ 
        Order2:=Order2, _ 
        Header:=Header 
Case Else: 
        SortData.Sort Key1:=rngKey1, _ 
        Order1:=Order1, _ 
        Header:=Header 
    End Select 
     
     'remove the helper column that we previously inserted
    SortData.Cells(1, 2).EntireColumn.Delete 
     
     'tidy up
    Set cell = Nothing 
    Set rngData = Nothing 
    Set rngToSort = Nothing 
    Set rngKey1 = Nothing 
    Application.ScreenUpdating = True 
     
End Sub 
 
 '----------------------------------------------------
 ' End of mSortByColour code module
 '----------------------------------------------------