Public Sub MarkDuplicates() 
Dim t$ 
On Error Resume Next 

Colors = Array(12900829, 15849925, 14408946, 14610923, 15986394, 14281213, 14277081, _ 
9944516, 14994616, 12040422, 12379352, 15921906, 14336204, 15261367, 14281213) 

Dim coll As New Collection, dupes As New Collection, _ 
cols As New Collection, ra As Range, cell As Range, n& 
Err.Clear: Set ra = Intersect(Selection, ActiveSheet.UsedRange) 
If Err Then Exit Sub 

ra.Interior.ColorIndex = xlColorIndexNone: Application.ScreenUpdating = False 
For Each cell In ra.Cells 
t = Split(cell.Value)(0) 
Err.Clear: If Len(Trim(cell)) Then coll.Add t, t 
If Err Then dupes.Add t, t 
Next cell 
For i& = 1 To dupes.Count 
n = n Mod (UBound(Colors) + 1): cols.Add Colors(n), dupes(i): n = n + 1 
Next 
For Each cell In ra.Cells 
t = Split(cell.Value)(0) 
cell.Interior.Color = cols(t) 
Next cell 
Application.ScreenUpdating = True 
End Sub