# How to Locate and Highlight Matching Cells

• ### Question

• I have the following coding that looks in range ("J3:J122") for the cells that match those in range ("B3:B18") and fills each matching pair of cells with the same colour.

Sub Match_PF_Pairs()

Application.ScreenUpdating = False

Dim ColourIndex  As Long

Dim iRng    As Range
Dim lRng    As Range
Dim rng     As Range

Dim x       As Long

Set iRng = Range("B3:B18")
Set lRng = Range("J3:J122")
x = 0

ColourIndex = 35

iRng.Interior.Color = xlNone
lRng.Interior.Color = xlNone

For Each rng In iRng
On Error Resume Next
x = Application.WorksheetFunction.Match(rng.Value, lRng, 0) + 2
If x > 2 Then
rng.Interior.ColorIndex = ColourIndex
Cells(x, 10).Interior.ColorIndex = ColourIndex
x = 0
ColourIndex = ColourIndex + 1
If ColourIndex > 48 Then ColourIndex = 35
End If

On Error GoTo 0
Next rng

Set iRng = Nothing
Set lRng = Nothing

Application.ScreenUpdating = True

End Sub

I now want to extend this slightly. Range ("M3:M122") contains the same values that are in range ("J3:J122") but sorted in a different way. I want to look in both ranges to find the cells that match those in range ("B3:B18") and fill the three of them with the same colour. For clarity, let's say for example that cells B3, J27 and M14 each contain 'ABC'; those three cells would each be coloured ColourIndex 35; cells B4, J85 and M93 each contain 'DEF' so those three would be coloured ColourIndex 36. And so on down until each cell in range ("B3:B18") is colour-matched with a cell in col J and a cell in col M

Each value in range ("B3:B18") occurs only once in col J and once in col M.

Help to modify the above coding to include this additional range would be much appreciated as I just cannot nut out how to do it!

• Edited by Saturday, April 23, 2016 9:59 AM
Saturday, April 23, 2016 9:58 AM

• Thanks Jim - that does the job perfectly - and throws up some very interesting results in the application it's being used on.

Very much appreciated.

• Marked as answer by Saturday, April 23, 2016 2:23 PM
Saturday, April 23, 2016 2:23 PM

### All replies

• Re:  find and color

Sub Match_PF_PairsR1()

Application.ScreenUpdating = False

Dim ColourIndex  As Long
Dim bRng    As Range
Dim jRng    As Range
Dim mRng  As Range
Dim rng     As Range
Dim x       As Long

Set bRng = Range("B3:B18").Cells
Set jRng = Range("J3:J122").Cells
Set mRng = Range("M3:M122").Cells

ColourIndex = 35
bRng.Interior.Color = xlNone
jRng.Interior.Color = xlNone
mRng.Interior.Color = xlNone

For Each rng In bRng
On Error Resume Next
x = Application.WorksheetFunction.Match(rng.Value, jRng, 0)
If x > 0 Then
rng.Interior.ColorIndex = ColourIndex
jRng(x).Interior.ColorIndex = ColourIndex
x = 0

x = Application.WorksheetFunction.Match(rng.Value, mRng, 0)
If x > 0 Then mRng(x).Interior.ColorIndex = ColourIndex
x = 0

ColourIndex = ColourIndex + 1
If ColourIndex > 48 Then ColourIndex = 35
End If
On Error GoTo 0
Next rng

Set bRng = Nothing
Set jRng = Nothing
Set mRng = Nothing
Application.ScreenUpdating = True

End Sub

'---
Jim Cone
Portland, Oregon USA
https://www.dropbox.com/sh/ttybwg5e9r31twa/AAAnyBTHPX5XsTDp10ItTcw4a?dl=0
free & commercial excel programs

• Edited by Wednesday, September 21, 2016 10:32 PM
Saturday, April 23, 2016 12:03 PM
• Thanks Jim - that does the job perfectly - and throws up some very interesting results in the application it's being used on.

Very much appreciated.

• Marked as answer by Saturday, April 23, 2016 2:23 PM
Saturday, April 23, 2016 2:23 PM