Loop Problem

[John]

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

 

[Lars-Åke Aspelin]

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

Try changing
rgPetName = Range(Cells(r, c))
to
rgPetName = Range(Cells(r, c),Cells(r,c))

Hope this helps

Lars-Åke

 

[Lars-Åke Aspelin]

Try changing
rgPetName = Range(Cells(r, c))
to
rgPetName = Range(Cells(r, c),Cells(r,c))

Hope this helps

Lars-Åke

or simply
rgPetName = Cells(r, c)

 

[John]

Thanks for your help Lars.

I've discovered that I was doing a couple of things incorrectly; I needed to
change the "Set rgPetName = ActiveCell" to "Set rgPetName = Cells(r, c)" and
to put this statement inside the loop. I was finding that the first item in
the list was being renamed before that!

Thanks again for you time.

Best regards

John