Do Loop

[bahllr]

I am trying to get a Do Loop for the following problem:

If a cell (in range (B5:B10) = "1" then

select the 4 cells to the right of that cell (with the "1")
and highlight them.

next cell

I have part of this but can't seem to get it to work....could someone please help me?

Sub test()

Range("b5").Activate
If ActiveCell.Value = 1 Then
Range(ActiveCell, ActiveCell.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
ActiveCell.Offset(1, 0).Select

End If
End Sub

 

[BC...]

I'd use a For..Next

Sub test()

Range("b5").Activate

For Counter = 1 to 10
If ActiveCell.Value = 1 Then
Range(ActiveCell, ActiveCell.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
end if
ActiveCell.Offset(1, 0).Select
Next Counter

End Sub

 

[bahllr]

Thanks, BC. That seemed to do it!