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.