You don't need VBA for this. Conditional formatting will do it. Base
your conditional formula on a COUNTIF statement, highlighting wheere the
COUNTIF gives a value  of >1 when the individual cell is compared to the
whole range  of names.

I designed today a formula how does just that and even uses a dynamic range
for itself to function...

=AANTAL.ALS(VERSCHUIVING($A$2;0;0;AANTALARG($A:$A)-1;AANTALARG($A$2:$B$2));A
2)>1

where:
AANTAL.ALS = COUNTIF
VERSCHUIVING = OFFSET
AANTALARG = COUNTA

Be sure to be on A1 of the range  (= A2 in my example because row 1 contains
labels). Notice that it takes all the rows in account and only two columns
so

=AANTAL.ALS(VERSCHUIVING($A$2;0;0;AANTALARG($A:$A)-1;2);A2)>1

does the same as the formula above.

This worked for me:


Private Sub CommandButton1_Click()
Dim i, j, k, j1, i1, limit
Dim objdict As Dictionary
Dim objsheet As Worksheet
Set objdict = New Dictionary
Set objsheet = Sheets("Sheet1")
k = 1
For j = 2 To 5
For i = 1 To 250
If objdict.exists(objsheet.Cells(i, j).Value) Then
objsheet.Cells(i, j).Font.Color = 255
If Not IsEmpty(objsheet.Cells(i, j)) Then
For j1 = 2 To j
If j1 = j Then limit = i - 1 Else limit = 250
For i1 = 1 To limit
If objsheet.Cells(i, j).Value = _
objsheet.Cells(i1, j1).Value _
Then objsheet.Cells(i1, j1).Font.Color = 255
Next i1
Next j1
End If
Else
If Not IsEmpty(objsheet.Cells(i, j)) Then objdict.Add objsheet.Cells
(i, j).Value, k
k = k + 1
End If
Next
Next
End Sub

There were a few problems with it adding the first empty cell it came
across as an item in the dictionary which then slowed the rest down
as it scanned for repeats of empty cells and changed the empty cell's
font to red  but that is now catered for.