Compare two Columns and format matching cells with different colors

Question

I would appreciate your help with the following:

I would like to compare two columns, let us say Column A and Column B, **looking for duplicates**.

 

If a value in Column A has a match value in Column B, I would like to format the cells of the same duplicate value with the color (the colors are random and different for each match).

 

This is if `A12 = B30`, the color will be red. And if `A20 = B1`, the color is green and so on.

 

If there is no match just leave it as it.

 

That was only an example for red and green. let say you have two columns (A and B).

A1 = 1000

A2 = 2000

A3 = 3000

A4 = 4000

A5 = 5000

A6 = 6000

A7 = 7000

A8 = 8000

A9 = 9000

 

B1 = 1500

B2 = 9000

B3 = 5000

B4 = 3500

B5 = 7500

B6 = 1000

B7 = 4000

 

So you have several matches and I need each match to be in random different colors. For example:

A1 = B6  –> They will be colored/highlighted in green

A4 = B7   –> They will be colored/highlighted in red

A5 = B3 –> They will be colored/highlighted in yellow

A9 = B2   –> They will be colored/highlighted in pink

 

The colors will be different for any match and the non-match will be color less or no change.

 

I wish this will explain the question and this has to be using excel.

{

Sub UsingCollection()
Dim cUnique As Collection
Dim Rng As Range
Dim Cell As Range
Dim sh As Worksheet
Dim vNum As Variant for at
Dim LstRw As Long
Dim c As Range, clr As Long, x

Set sh = ActiveSheet
With sh

    LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Rng = .Range("A1:B" & LstRw)
    Set cUnique = New Collection
    Rng.Interior.ColorIndex = xlNone
    clr = 3

    On Error Resume Next
    For Each Cell In Rng.Cells
        cUnique.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0

    For Each vNum In cUnique

        For Each c In Rng.Cells
            If c = vNum Then
                x = Application.WorksheetFunction.CountIf(Rng, vNum)
                If x > 1 Then c.Interior.ColorIndex = clr "error here: the code runs fine for around 50 lines then it is stoppedand gives error and pointing to this line"
                  //Error shows in pop window: Run-time error 'g': Subscript out of range
            End If
        Next c
        clr = clr + 1
     Next vNum

   End With


End Sub

}

Answer 1

This is an adjusted code from my answer here.

https://stackoverflow.com/a/33798531/1392235

Loop through the cells to find the unique values, then loop through the unique values to color the duplicates.

Sub UsingCollection()
    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
    Dim LstRw As Long
    Dim c As Range, clr As Long, x

    Set sh = ActiveSheet
    With sh

        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rng = .Range("A1:B" & LstRw)
        Set cUnique = New Collection
        Rng.Interior.ColorIndex = xlNone
        clr = 3

        On Error Resume Next
        For Each Cell In Rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
        On Error GoTo 0

        For Each vNum In cUnique

            For Each c In Rng.Cells
                If c = vNum Then
                    x = Application.WorksheetFunction.CountIf(Rng, vNum)
                    If x > 1 Then c.Interior.ColorIndex = clr
                End If
            Next c
            clr = clr + 1
        Next vNum

    End With

End Sub

Results

Sample Workbook

EDIT:

Using colorindex limits us to 56 colors, if we use RGB we can increase that. Edit this part of the code, you will have to play with the values get the color variances you like.

       If x > 1 Then c.Interior.Color = 1000000 + clr * 100
            End If
        Next c
        clr = clr + 255