Hi,

I'm still trying to get to grips with VBA and would appreciate some help
with this looping problem (I know its very basic normal users!):

I'm trying to write a procedure that I can run on the active cell at the top
of a list of names, so that it will fill the adjacent cell with a predifined
colour:

So far I've got to this:

Sub SetAjacentCellColour()

Dim rgPetName As Range
Dim r As Integer
Dim c As Integer

Set rgPetName = ActiveCell

r = ActiveCell.Row
c = ActiveCell.Column

Do
If IsEmpty(Cells(r, c)) Then Exit Do

Select Case rgPetName
Case "Cat": Cells(r, c).Offset(0, 1).Interior.ColorIndex = 5
Case "Dog": Cells(r, c).Offset(0, 1).Interior.ColorIndex = 6
Case Else: MsgBox "Pet type not in colour list"
End Select

r = r + 1
'This is where its getting stuck
rgPetName = Range(Cells(r, c))


Loop

MsgBox "Finished"

End Sub

It's getting stuck on the part where I'm trying to tell it to move the
rgPetName range down to the next cell. I know this isn't the right way so
please feel free to set a new student straight.

Many thanks

John


List example:

Dog
Cat
Dog
Dog
Dog
Cat