Excel VBA

Color Rows by Criteria

When my friend eventually got me to convert to VBA, this was one of the first things I did.

The app is now part of a comprehensive toolkit that I have been building for my workgroup. In it’s current iteration, I use a userform to present a list of color names (some from Excel and others from my own observation). It highlighted and formatted a 10,000 row table in mere seconds. [1.5 GB RAM]

Sub ColorRows()
    Dim I As Integer, Color As Integer, LastRow As Integer
    Dim daColors As String
    Dim BottomRw, LastCol, ColorNames, ColorNumbs, ColorCode As Long
    Unload usrColorRows  'Zap userform from last time
    ColorNames = Array("Red", "Bright Green", "Blue", "Yellow", "Pink", "Aqua", "Olive", "Teal", "Grey 25%", "Grey 40%", _
        "Grey 50%", "Purple", "Plum", "Maize", "Light Blue", "Light Purple", "Fushia", "Bright Yellow", "Light Blue", _
        "Light Turquoise", "Light Green", "Light Yellow", "Pale Blue", "Rose", "Lavender", "Tan", "Aqua", "Lime", _
        "Gold", "Light Orange", "Orange", "Brown")
    ColorNumbs = Array(2, 3, 4, 5, 6, 7, 11, 13, 14, 47, 15, 16, 17, 18, 19, 23, 25, 26, 32, _
        33, 34, 35, 36, 37, 38, 39, 41, 42, 43, 44, 45, 52)
    With usrColorRows.cmbColors
        For I = LBound(ColorNumbs) To UBound(ColorNumbs)
            .AddItem ColorNumbs(I) & " =" & ColorNames(I)   'Build ComboBox of Color Values
        Next
    End With
    usrColorRows.Show
     'Converted to ListBox 04/07/2005 ARB
    ColorCode = Left(usrColorRows.cmbColors.Value, 2) + 1    'Strip off selected color
    Range("A2").Select
    '---------
    LastRow = ActiveCell.SpecialCells(xlLastCell).Row
    LastCol = ActiveCell.SpecialCells(xlLastCell).Column
     'Un-color cells before new colors
    ActiveSheet.Range(Cells(1, 1), Cells(LastRow, LastCol)). _
            Interior.ColorIndex = xlNone

    For I = 2 To LastRow Step 2      'Step 2 insures alternating rows
        ActiveSheet.Range(Cells(I, 1), Cells(I, LastCol)). _
                Interior.ColorIndex = ColorCode     'ColorCode arrives with
    Next                             'This For…Next does all coloring
    ActiveSheet.Range(Cells(2, 1), Cells(LastRow, LastCol)).Select
    With Selection.Borders(xlLeft)   'Several pieces of housekeeping
        .Weight = xlThin             'to put border around every cell
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlRight)
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlTop)
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlBottom)
        .Weight = xlThin
        .ColorIndex = xlAutomatic     'Several pieces of housekeeping
    End With                          'to put border around every cell
    With Selection
        .BorderAround Weight:=xlThin, ColorIndex:=xlAutomatic
    End With
    Columns("A:IV").Select
    With Selection
   '      .AutoFilter                'Insert “AutoFilter” at tops
        .Columns.AutoFit            'Pretty the columns to “Best Fit”
    End With
    Range("A1").Select
    Unload usrColorRows
End Sub

You would think that you could simply start counting the colors in the toolbar and arrive at the exact number for each color. I found out differently. If you ’customize‚ the colors, Excel still reports the color name that was originally there.