Excel VBA

css navigation by Css3Menu.com

Color Rows by Criteria

Since this was originally written in 1994, there have been continual changes. It was written for Excel 3.0 macro language; updated for versions 4.0 and 5.0 and tweaked to run as 4.0 language in 7.0.

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
    End With
     'Converted to ListBox 04/07/2005 ARB
    ColorCode = Left(usrColorRows.cmbColors.Value, 2) + 1    'Strip off selected color
    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
    With Selection
   '      .AutoFilter                'Insert “AutoFilter” at tops
        .Columns.AutoFit            'Pretty the columns to “Best Fit”
    End With
    Unload usrColorRows
End Sub
Choose a color, any color!

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.

© 1994-2024

Updated:  01/23/2024 13:34
This page added:  15 March 1994