I am struggling to find any info on the internet to make this work, please help me out.

I would like a function to do the following (summarized below)

1. As you can see column A3:A7 has a number in each cell and a colour associated with that specific number.

2. I would like the code to scan through A3:A7 and match the numbers in C3:C7 with the colour that's already applied. (See below for detailed explanation)

3. For instance, A3 has a value of 1 and is yellow, I would like the code to scan through all numbers in Column C (C3:C7) and identify that C6 is also 1, therefore it will apply yellow to C6.

Initial:

Final:

Also can this be done across two different Sheets.For example lets say A3:A7 is on Sheet1 and I want to find matches in C3:C7 in Sheet2

CodePudding user response：

Sub ColourCells()

Dim Rng1 As Range, Rng2 As Range, Rng2Item As Range
Dim Rng1LRow As Long, Rng2LRow As Long
Dim Rng1Match As Variant

With Worksheets("Sheet1")
    Rng2LRow = .Cells(.Rows.Count, 3).End(xlUp).Row
    Set Rng2 = .Range("C3:C" & Rng2LRow)
End With

With Worksheets("Sheet2")
    Rng1LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Rng1 = .Range("A3:A" & Rng1LRow)
End With

For Each Rng2Item In Rng2
    With Rng2Item
        Rng1Match = Application.Match(.Value, Rng1, 0)
        If IsError(Rng1Match) Then
            GoTo NextItem
        Else
            .Interior.Color = Application.Index(Rng1, Rng1Match, 0).Interior.Color
        End If
    End With
NextItem:
Next Rng2Item

End Sub

CodePudding user response：

Sub test()
Dim rng1 As Range, rng2 As Range, rng As Range
Set rng1 = Range("A3:A7")
Set rng2 = Range("C3:C7")

For Each rng In rng2
    With Application.WorksheetFunction
        If .CountIf(rng1, rng.Value) > 0 Then rng.Interior.Color = .Index(rng1, .Match(rng.Value, rng1, 0), 1).Interior.Color
    End With
Next rng

Set rng1 = Nothing
Set rng2 = Nothing

End Sub