Sub dcmdc()
Dim d As Object, r, s
Set d = CreateObject("scripting.dictionary")
d.comparemode = 0
For Each r In ActiveSheet.UsedRange.Rows
    For Each s In r.Cells
        If Len(s) > 0 Then _
            If d(s.Value) = 1 Then s.Font.Color = vbRed  Else d(s.Value) = 1
    Next s
    d.RemoveAll
Next r
End Sub