Compare two Columns and format matching cells with different colors - excel

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