New TWIST on LOOKUP Match n' Copy to diff sheet -- using font color as part of the required criteria

ChrisOK

Well-known Member
Joined
Mar 26, 2003
Messages
601
Ideas on vba to do the following: On Sheet1, starting w/ Column AC, Row 4 take the first cell (that has red font) and try to locate a match on Sheet2 within Column C, starting with Row 2 going down.
=If match found, turn background of that cell on Sheet1 to blue.
=If not found, move to next red font cell within Sheet1, Col AC and repeat search.

*Important: if it comes across a cell in Col AC that has any other font color, ignore it and only search using cells with red font.
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
-bump- still looking for a resolution.. thx in advance for any help to achieve the above.. :confused:
 
Upvote 0
Something like this...

With caution that there are many interpretations of the 'Red' and 'Blue'

Code:
Sub Foo()

Dim rngSource As Range, rngSearch As Range
Dim c As Range, Found As Range


Set rngSource = Sheets("Sheet1").UsedRange.Columns("AC").Cells
Set rngSearch = Sheets("Sheet2").UsedRange.Columns("C").Cells
For Each c In rngSource
    If c.Row > 3 Then
    If c.Font.Color = vbRed Then
        Set Found = rngSearch.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Found Is Nothing Then
            c.Interior.Color = vbBlue
            Set Found = Nothing
        End If
    End If
    End If
Next c


End Sub
 
Upvote 0
Encountered a prob: got "Run time error 9, subscript out of range" and the following line of code is highlighted:
Code:
Set rngSearch = Sheets("Sheet2").UsedRange.Columns("C").Cells
Out of curiosity when this occured, I tested both columns of each sheet: "ISTEXT(AC4)" and got "TRUE", however, when I did the same thing on the other sheet 2, column C, I got "#NAME?" ..... however, when I tried "ISNUMBER(C2)" I get "FALSE".... so, could this be why it is not able to run matching without error? Sheet 1's column AC is text but Sheet 2's column C is ]"#NAME?"

If so, what do you suggest for fixing COL "C" of the sheet 2, so it is comparing apples to apples...?
 
Last edited:
Upvote 0
OK - Revised version

This one fixes range references:rolleyes: and interogates if the value being searched is numeric or not and adjusts the search accordingly.

Code:
Sub SearchRedFontInSheet1SetToBlueFillIfFoundInSheet2()
   
    Dim rngSource As Range 'Range being looped through to search via For Each/Next
    Dim rngSearch As Range 'Range to Search
    Dim c As Range 'individual cell providing value of the search
    Dim Found As Range 'Search Result
    
    Const Reset = False 'If True, Resets the fill color of rngSource to xlNone


    'Create Source Range
    With Sheets("Sheet1")
        lr = .Cells(.Rows.Count, .Columns("AC").Column).End(xlUp).Row
        Set rngSource = Sheets("Sheet1").Range("AC4:AC" & lr)
    End With
    
    'Create Search Range
    With Sheets("Sheet2")
        lr = .Cells(.Rows.Count, .Columns("C").Column).End(xlUp).Row
        Set rngSearch = Sheets("Sheet2").Range("C1:C" & lr)
    End With


    If Reset Then rngSource.Interior.Color = xlNone
    
    'Loop through cells of Source Range
    For Each c In rngSource
        'If Font Color is 'Red'
        If c.Font.Color = 255 Then
            'Test for numeric or not; submit search to set Found
            Select Case IsNumeric(c)
            Case Is = False
            Set Found = rngSearch.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
            Case Else
            Set Found = rngSearch.Find(CLng(c.Value), LookIn:=xlValues, LookAt:=xlWhole)
            End Select


            'If Search Result then set interior fill color Source cell
            If Not Found Is Nothing Then
                c.Interior.Color = vbBlue
                Set Found = Nothing
            End If
        End If
    Next c  'cell in search range
End Sub
 
Last edited:
Upvote 0
I'm getting the same "Run time error 9, Subscript out of range" error, this is the line that's highlighted:
Not sure why??

Code:
    With Sheets("Sheet2")
 
Upvote 0
I'm getting the same "Run time error 9, Subscript out of range" error, this is the line that's highlighted:
Not sure why??

Code:
    With Sheets("Sheet2")
Do you actually have a sheet that is named "Sheet2" (that error is saying you don't)?
 
Upvote 0
No, Rick, I don't, here's the actual code (with the "real names" in place...) This is the code I ran it on -- and got the error.
The code I posted on the site was edited to be more 'generic'.

Perhaps you see something in this that would cause that to error?
Code:
Sub CPUPproject2SearchRedFontInSheet1SetToBlueFillIfFoundInSheet2()
   
    Dim rngSource As Range 'Range being looped through to search via For Each/Next
    Dim rngSearch As Range 'Range to Search
    Dim c As Range 'individual cell providing value of the search
    Dim Found As Range 'Search Result
    
    Const Reset = False 'If True, Resets the fill color of rngSource to xlNone


    'Create Source Range
    With Sheets("SUMMARY")
        lr = .Cells(.Rows.Count, .Columns("AC").Column).End(xlUp).Row
        Set rngSource = Sheets("SUMMARY").Range("AC4:AC" & lr)
    End With
    
    'Create Search Range
    With Sheets("LOCKEED IPV")
        lr = .Cells(.Rows.Count, .Columns("C").Column).End(xlUp).Row
        Set rngSearch = Sheets("LOCKEED IPV").Range("C1:C" & lr)
    End With


    If Reset Then rngSource.Interior.Color = xlNone
    
    'Loop through cells of Source Range
    For Each c In rngSource
        'If Font Color is 'Red'
        If c.Font.Color = 255 Then
            'Test for numeric or not; submit search to set Found
            Select Case IsNumeric(c)
            Case Is = False
            Set Found = rngSearch.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
            Case Else
            Set Found = rngSearch.Find(CLng(c.Value), LookIn:=xlValues, LookAt:=xlWhole)
            End Select


            'If Search Result then set interior fill color Source cell
            If Not Found Is Nothing Then
                c.Interior.Color = vbBlue
                Set Found = Nothing
            End If
        End If
    Next c  'cell in search range
End Sub

Thanks so much for taking a look! MUCH appreciated!

BTW** the color I'm using is 255 for red -- just for confirmation. And any blue may be used as desired to colorize the cell background when the match is found.
 
Last edited:
Upvote 0
No, Rick, I don't, here's the actual code (with the "real names" in place...) This is the code I ran it on -- and got the error.
The code I posted on the site was edited to be more 'generic'.

Perhaps you see something in this that would cause that to error?
Rich (BB code):
Sub CPUPproject2SearchRedFontInSheet1SetToBlueFillIfFoundInSheet2()
   
    Dim rngSource As Range 'Range being looped through to search via For Each/Next
    Dim rngSearch As Range 'Range to Search
    Dim c As Range 'individual cell providing value of the search
    Dim Found As Range 'Search Result
    
    Const Reset = False 'If True, Resets the fill color of rngSource to xlNone


    'Create Source Range
    With Sheets("SUMMARY")
        lr = .Cells(.Rows.Count, .Columns("AC").Column).End(xlUp).Row
        Set rngSource = Sheets("SUMMARY").Range("AC4:AC" & lr)
    End With
    
    'Create Search Range
    With Sheets("LOCKEED IPV")
        lr = .Cells(.Rows.Count, .Columns("C").Column).End(xlUp).Row
        Set rngSearch = Sheets("LOCKEED IPV").Range("C1:C" & lr)
    End With


    If Reset Then rngSource.Interior.Color = xlNone
    
    'Loop through cells of Source Range
    For Each c In rngSource
        'If Font Color is 'Red'
        If c.Font.Color = 255 Then
            'Test for numeric or not; submit search to set Found
            Select Case IsNumeric(c)
            Case Is = False
            Set Found = rngSearch.Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
            Case Else
            Set Found = rngSearch.Find(CLng(c.Value), LookIn:=xlValues, LookAt:=xlWhole)
            End Select


            'If Search Result then set interior fill color Source cell
            If Not Found Is Nothing Then
                c.Interior.Color = vbBlue
                Set Found = Nothing
            End If
        End If
    Next c  'cell in search range
End Sub
First off, it is usually not a good idea to simplify your questions for us... and it looks like your real code may be a good example why. Is the word I highlighted in red really spelled that way on the worksheet tab or is that word supposed to be "LOCKED" with one "E"?
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

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
Back
Top