InStr search and commas in a cell - excel

Question

I have a bunch of column of rows that contain text such as:
dog,cat,mouse
bat,dog,fly
fish,beaver,horse
I'm trying to search and highlight rows that contain certain word:
Public Sub MarkDuplicates()
Dim iWarnColor As Integer
Dim rng As Range
Dim rngCell As Variant
Dim LR As Long
Dim vVal
Dim tRow
LR = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B1:B" & LR)
iWarnColor = xlThemeColorAccent2
For Each rngCell In rng.Cells
tRow = rngCell.Row
If InStr(rngCell.Value, "dog") = 1 Then
rngCell.Interior.ColorIndex = iWarnColor
Else
rngCell.Interior.Pattern = xlNone
End If
Next
End Sub
This works fine so long as the word 'dog' is the first word in the comma string, so it would highlight the first row but not row two because the word 'dog' appears after 'bat'. Do I need to strip the commas out first or is there a better way of doing this?

Answer 1

It looks like your ultimate goal is to color the row based on whether or not 'dog' is in a cell. Here's a different way to do it that doesn't even involve VBA (this example assumes your data is all in column A):
Make a new column to the right. Use the formula =IF(NOT(ISERROR(FIND("dog",A1))),1,0). You can hide the column later so the user doesn't see it. Basically, if it has the word 'dog' somewhere, then return 1 else 0.
Select the entire first row
Under Conditional Formatting, go to New Rule
Choose Use a Formula
For your formula, try =$B2=1
Now that you've conditionally colored one row, copy and paste format to the other rows.
All rows should now update automatically.
Extra Credit: If this data is formatted as a table object, the conditional formatting should automatically carry over to new rows as they are added.

Answer 2

Further to my comments above
Example 1 (Using .Find and .Findnext)
Option Explicit
Public Sub MarkDuplicates()
Dim ws As Worksheet
Dim iWarnColor As Integer
Dim rng As Range, aCell As Range, bCell As Range
Dim LR As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
iWarnColor = xlThemeColorAccent2
With ws
LR = .Range("B" & .Rows.Count).End(xlUp).Row
Set rng = .Range("B1:B" & LR)
rng.Interior.ColorIndex = xlNone
Set aCell = rng.Find(What:="dog", LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
aCell.Interior.ColorIndex = iWarnColor
Do
Set aCell = rng.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
aCell.Interior.ColorIndex = iWarnColor
Else
Exit Do
End If
Loop
End If
End With
End Sub
Screenshot
Example 2 (Using Autofilter)
For this ensure that there is a Heading in Cell B1
Option Explicit
Public Sub MarkDuplicates()
Dim ws As Worksheet
Dim iWarnColor As Integer
Dim rng As Range, aCell As Range
Dim LR As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
iWarnColor = xlThemeColorAccent2
With ws
'~~> Remove any filters
.AutoFilterMode = False
LR = .Range("B" & .Rows.Count).End(xlUp).Row
Set rng = .Range("B1:B" & LR)
With rng
.AutoFilter Field:=1, Criteria1:="=*dog*"
Set aCell = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
End With
If Not aCell Is Nothing Then aCell.Interior.ColorIndex = iWarnColor
'~~> Remove any filters
.AutoFilterMode = False
End With
End Sub