Set ActiveCell value based upon text string in neighbor cell for whole column

[Matt_in_CA]

Hello,
I’ve written the below VBA code, and it works, but it seems klunky. Can you streamline/improve?
This code populates a blank column based upon a possible text string in the neighboring cell. For example if the neighboring cell contains anywhere the string “DOG” then the value for the ActiveCell will be “CANINE”. If the neighbor cell contains “CAT” the ActiveCell will be “FELINE”. If the neighbor cell contains “HORSE”, the ActiveCell will be “EQUINE”. And so on.
The idea is that the macro creates a “sort code column” based upon a chunk of text from a file that downloads from an outside system. Then, I just SUMIF and manipulate the data now that each record has a category (sort) code.
I can attach a sample worksheet, but I don't see where in the forum to add attachments.
Like I say, it works, but there are 2 problems: 1. I think it might be a bit klunky. Is there any simpler way to code this? Like using Select-Case structure? Unlike my example, in the actual application there are about 40 different Sort/Category codes and hundreds of downloaded records. 2. The other problem is that my code does not provide for a multi criterion selection. In other words in the neighbor cell contains “CAT” and (anywhere) “SIAMESE”, then the ActiveCell should read “CAT-EXOTIC”. If the neighbor cell contains “HORSE” and “KENTUCKY” then the ActiveCell should read “RACEHORSE”. And so on.
CODE HERE:
Sub FillSortCodePost()
Do While ActiveCell.Offset(0, 1).Value <> Empty
If InStr(1, ActiveCell.Offset(0, 1).Value, "CAT") <> 0 Then ActiveCell.Value = "FELINE"
If InStr(1, ActiveCell.Offset(0, 1).Value, "DOG") <> 0 Then ActiveCell.Value = "CANINE"
If InStr(1, ActiveCell.Offset(0, 1).Value, "HORSE") <> 0 Then ActiveCell.Value = "EQUINE"
ActiveCell.Offset(1, 0).Select
Loop
End Sub
END OF CODE HERE.
Thanks so much!
Matt

 

[JLGWhiz]

You can probably just use your category list, rather than try to incorporate that many items into a Select Case or IF...ELSEIF algorithm. Your list of keywords and categories, dog, cat, horse, etc. could be listed on a separate worksheet 2 in column A beginning in Cell 1 with the appropriate category in the column B adjacent cell , and your key words would be in column A of sheet 1.

Sub categorize()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, c As Range, fLoc As Range, fAdr As String
Set sh1 = Sheets(1) 'Edit sheet name - this would be your data sheet
Set sh2 = Sheets(2) 'Edit sheet name
lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In sh2.Range("A1:A" & lr)
        Set fLoc = sh1.Range("A:A").Find(c.Value, , xlValues, xlPart)
            If Not fLoc Is Nothing Then
                fAdr = fLoc.Address
                Do
                    fLoc.Offset(0, 1) = c.Offset(0, 1).Value
                    Set fLoc = sh1.Range("A:A").FindNext(fLoc)
                Loop While fLoc.Address <> fAdr
            End If
    Next
End Sub

This just walks down your list of keywords and searches for a match in the other sheet. If a match is found, it then enters the category for that keyword next to the matched item. It will search the entire worksheet for each occurrence of each keyword before moving to the next one, until all have been searched and the categories entered.

 

[Matt_in_CA]

Hi JLGWhiz,
Great idea! I will try this out.
Thanks,
Matt

 

[JLGWhiz]

Hi JLGWhiz,
Great idea! I will try this out.
Thanks,
Matt

You are welcome.
Regards, JLG