none
How to Locate and Highlight Matching Cells RRS feed

  • 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 DaviDWF2 Saturday, April 23, 2016 9:59 AM
    Saturday, April 23, 2016 9:58 AM

Answers

  • 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 DaviDWF2 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 James Cone 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 DaviDWF2 Saturday, April 23, 2016 2:23 PM
    Saturday, April 23, 2016 2:23 PM