Color cells in a Range if it matches strings in array found in another range

DeonM

New Member
Joined
Sep 18, 2014
Messages
26
I have the following code that basically works fine. The purpose is to highlight any cells in the "Lookup" sheet that match any of the strings found in the specified range in the "Fails" sheet.

The problem is that this method won't highlight a second or third etc. occurrence of the string in the Lookup sheet. My logic tells me I should loop through the "Lookup" range and compare to the values in the "Fails" array. I've tried lots of different loops, but can't get it to work.

Any help please!!!


Code:
        Dim myArray As Variant, word As Variant
        Dim LastSrcRow As Long, LastDestRow As Long
        
        LastSrcRow = Worksheets("Fails").Range("A65536").End(xlUp).row
        LastDestRow = Worksheets("Lookup").Range("A65536").End(xlUp).row
                
        myArray = Worksheets("Fails").Range("T2:T" & LastSrcRow).Value
                  
        For Each word In myArray
            Worksheets("Lookup").Range("E2:F" & LastDestRow).Find(word).Interior.ColorIndex = 22
        Next word
 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,118
Try:
Code:
Sub Test()
    Application.ScreenUpdating = False
    Dim LastSrcRow As Long, word As Range, sAddr As String, fnd As Range
    LastSrcRow = Sheets("Fails").Range("A" & Rows.Count).End(xlUp).Row
    For Each word In Sheets("Fails").Range("T2:T" & LastSrcRow)
        Set fnd = Sheets("Lookup").Range("E:F").Find(word, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            sAddr = fnd.Address
            Do
                fnd.Interior.ColorIndex = 22
                Set fnd = Sheets("Lookup").Range("E:F").FindNext(fnd)
            Loop While fnd.Address <> sAddr
            sAddr = ""
        End If
    Next word
    Application.ScreenUpdating = True
End Sub
 

DeonM

New Member
Joined
Sep 18, 2014
Messages
26
Try:
Code:
Sub Test()
    Application.ScreenUpdating = False
    Dim LastSrcRow As Long, word As Range, sAddr As String, fnd As Range
    LastSrcRow = Sheets("Fails").Range("A" & Rows.Count).End(xlUp).Row
    For Each word In Sheets("Fails").Range("T2:T" & LastSrcRow)
        Set fnd = Sheets("Lookup").Range("E:F").Find(word, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            sAddr = fnd.Address
            Do
                fnd.Interior.ColorIndex = 22
                Set fnd = Sheets("Lookup").Range("E:F").FindNext(fnd)
            Loop While fnd.Address <> sAddr
            sAddr = ""
        End If
    Next word
    Application.ScreenUpdating = True
End Sub


Thanks. That goes into a minutes long loop and eventually gives me a "Run time error 91. Object variable or With block variable not set" on "Loop While fnd.Address <> sAddr".

It also just highlights all blank cells in columns E:F and nothing of the values found in the Fails range.
 

DeonM

New Member
Joined
Sep 18, 2014
Messages
26
Sorry. Update to previous.

1. It seems the very long run time is caused by me having blank cells/values in the Fails range - therefore it finds all blanks in the Lookup Range as matches. I can solve that by cleaning the Fails range first of blank cells, but in your code, can one set it to ignore blank cells in the Fails range?
2. I also changed it a bit to define fnd Range as only including the used rows instead of entire columns.

Dim LastSrcRow As Long, word As Range, sAddr As String, fnd As Range, LastDestRow As Long
LastSrcRow = Sheets("Fails").Range("A65536").End(xlUp).row
LastDestRow = Worksheets("Lookup").Range("A65536").End(xlUp).row
For Each word In Sheets("Fails").Range("T2:T" & LastSrcRow)
Set fnd = Sheets("Lookup").Range("E2:F" & LastDestRow).Find(word, LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
sAddr = fnd.Address
Do
fnd.Interior.ColorIndex = 22
Set fnd = Sheets("Lookup").Range("E2:F" & LastDestRow).FindNext(fnd)
Loop While fnd.Address <> sAddr
sAddr = ""
End If
Next word
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,118

ADVERTISEMENT

This should take care of the blanks issue without you having to clean the Fails range of blank cells.
Code:
Sub Test()
    Dim LastSrcRow As Long, word As Range, sAddr As String, fnd As Range, LastDestRow As Long
    LastSrcRow = Sheets("Fails").Range("A65536").End(xlUp).Row
    LastDestRow = Worksheets("Lookup").Range("A65536").End(xlUp).Row
    For Each word In Sheets("Fails").Range("T2:T" & LastSrcRow)
        If word <> "" Then
            Set fnd = Sheets("Lookup").Range("E2:F" & LastDestRow).Find(word, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                sAddr = fnd.Address
                Do
                    fnd.Interior.ColorIndex = 22
                    Set fnd = Sheets("Lookup").Range("E2:F" & LastDestRow).FindNext(fnd)
                Loop While fnd.Address <> sAddr
                sAddr = ""
            End If
        End If
    Next word
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,564
Messages
5,596,863
Members
414,106
Latest member
Tigretto

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top