Entering Data into Column C based on word from Column A

[J.J.]

I am currently trying to figure out a macro that will enter data into
column C depending on a word in Column A

Column A Column B Column C

Dog Doggy
Cat
Elephant
Giraffe
Dog Food Doggy
Cat Food
Elephant Food
Giraffe Food

How do I go about doing this? Any help would be greatly appreciated.

 

[merjet]

Dim c As Range
For Each c In Sheet1.Range("A2:A9")
If InStr(LCase(c), "dog") > 0 Then c.Offset(0, 2) = "Doggy"
Next c

Hth,
Merjet

 

[J.J.]

after changing the range to encompass the larger range, I receive an
error highlighting

"If InStr(LCase(c), "dog") > 0 Then"

 

[JLGWhiz]

Here is another version:
Sub AnmlCrkrs()
Animal = Array("Dog", "Cat", "Elephant", "Giraffe")
lstRw = Cells(Rows.Count, 1).End(xlUp).Row
counter = 0
Do Until counter = 4
For Each c In Range("A2:A" & lstRw)
If c.Value Like "*" & Animal(counter) & "*" Then
cRng = c.Address
If counter = 0 Then
Range(cRng).Offset(0, 2) = "Doggy"
ElseIf counter = 1 Then
Range(cRng).Offset(0, 2) = "Kitty"
ElseIf counter = 2 Then
Range(cRng).Offset(0, 2) = "Pachy"
ElseIf counter = 3 Then
Range(cRng).Offset(0, 2) = "LongNeck"
End If
End If
Next
counter = counter + 1
Loop
End Sub

 

[merjet]

I receive an error highlighting

"If InStr(LCase(c), "dog") > 0 Then"

So what was in the cell that caused the error? The code handled blanks
and numbers for me just fine.

Hth,
Merjet

 

[Les Stout]

Hi JJ, try the following....

Sub Tester()
'
Dim rng As Range, rCell As Range
Dim WB As Workbook, SH As Worksheet
Dim r As Range, lastRow As Long

Set r = ActiveSheet.UsedRange
lastRow = r.Rows.Count
Const sStr As String = "cat" '<<===== CHANGE

Set WB = ActiveWorkbook '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE
Set rng = SH.Range("A1:A" & lastRow) '<<===== CHANGE Column to
search

For Each rCell In rng.Cells
With rCell
If LCase(rCell.Value) Like "*cat*" Then
rCell.Offset(0, 2).Value = "Cat" '<<=Change
End If
End With
Next rCell
End Sub


Les Stout

*** Sent via Developersdex http://www.developersdex.com ***