Sub ShadeEverySecondRow() Dim lRow As Long lRow = 2 Do Until IsEmpty(cells(lRow, 1)) cells(lRow, 1).EntireRow.Interior.ColorIndex = 15 lRow = lRow + 2 Loop End Sub