Answered by:
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 colourmatched with a cell in col J and a cell in col MEach 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 DaviDWF2 Saturday, April 23, 2016 9:59 AM
Answers
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 James Cone Wednesday, September 21, 2016 10:32 PM
