Sub ShadeEverySecondRow() Dim i As Integer i = 2 Do Until IsEmpty(Cells(i, 1)) Cells(i, 1).EntireRow.Interior.ColorIndex = 15 i = i + 2 Loop End Sub