Alternate Row Colors in Range

Alternating row colors can be done using conditional formatting:

screen capture


I needed a macro that would color every second row in a range, using only those rows that were visible. This is what I came up with. You don't have to loop through the rows.

Sub Color_Alt_Rows(Rng As Range)
    Application.ScreenUpdating = False

    Rng.Interior.ColorIndex = xlNone
    Rng = Rng.SpecialCells(xlCellTypeVisible)
    Rng.FormatConditions.Add Type:=xlExpression, Formula1:="=mod(row()+1,2)"
    Rng.FormatConditions(1).Interior.ColorIndex = 34
End Sub

Try it out with Color_Alt_Rows Range("a2:d5")


I need to do this frequently and like to be able to easily modify the colors I'm using for the banding. The following sub makes it very easy:

Sub GreenBarMe(rng As Range, firstColor As Long, secondColor As Long)
    rng.Interior.ColorIndex = xlNone
    rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=0"
    rng.FormatConditions(1).Interior.Color = firstColor
    rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)<>0"
    rng.FormatConditions(2).Interior.Color = secondColor
End Sub

Usage:

Sub TestGreenBarFormatting()
    Dim rng As Range
    Dim firstColor As Long
    Dim secondColor As Long

    Set rng = Range("A1:D12")
    firstColor = vbGreen
    secondColor = vbYellow

    Call GreenBarMe(rng, firstColor, secondColor)
End Sub

My Solution

A subroutine to assign to a button or some code

Public Sub Band_Goals()
    'Just pass the start and end rows
    'You will have to update the function to select the
    'the correct columns

    BandRows_Invisble 12, 144

End Sub

The Function

Private Sub BandRows_Invisble(StartRow As Integer, EndRow As Integer)

    Dim i As Long, nothidden As Boolean


    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Range("A" & StartRow & ":K" & EndRow).Interior.ColorIndex = xlNone

    For i = StartRow To EndRow
        If Not Rows(i).Hidden Then
            nothidden = nothidden + 1
            If Not nothidden Then
                    'Download this app to help with color picking
                    'http://www.iconico.com/download.aspx?app=ColorPic
                    Range("A" & i & ":K" & i).Interior.Color = RGB(196, 189, 151)

            End If
        End If
    Next i

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Tags:

Excel

Vba