Loop Problem

J

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
 
L

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
Click to expand...
Try changing
rgPetName = Range(Cells(r, c))
to
rgPetName = Range(Cells(r, c),Cells(r,c))

Hope this helps

Lars-Åke
 
L

Lars-Åke Aspelin

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

Hope this helps

Lars-Åke
Click to expand...


or simply
rgPetName = Cells(r, c)
 
J

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
 
Top