Public FirstInstance As Long, Dup As Boolean

Sub HighlightDups()
Dim MyDictionary As Scripting.Dictionary
Set MyDictionary = New Scripting.Dictionary
Dim MyDictionaryEntry As DictionaryEntry
Dim MyColour, palette, contents As Integer
Dim i, LastRow As Long
palette = 2

With ActiveSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With


With MyDictionary
For i = 1 To LastRow
Debug.Print (i)
contents = Cells(i, 1)
Debug.Print (contents)

' New key - create entry
If Not .Exists(contents) Then
Debug.Print ("Not exists")
    Set MyDictionaryEntry = New DictionaryEntry
    MyDictionaryEntry.FirstInstance = i
    .Add contents, MyDictionaryEntry
Else

    'Dup already found - retrieve previous colour
    If .Item(contents).Dup Then
        MyColour = Cells(.Item(contents).FirstInstance, 1).Interior.ColorIndex
        Cells(i, 1).Interior.ColorIndex = MyColour

    ' Dup not previously found - set new colour
    Else
        palette = palette + 1
        .Item(contents).Dup = True
        Cells(i, 1).Interior.ColorIndex = palette
        Cells(.Item(contents).FirstInstance, 1).Interior.ColorIndex = palette
    End If
End If
Next i
End With

End Sub