Sub test()
Dim rng As Range
Application.ScreenUpdating = 0
Set rng = Range("e20:g36")
rng.Font.ColorIndex = 1
For Each tmp In rng
s$ = ""
i1% = 0: i2% = 0: i3% = 0
For Each k In Split(tmp & ",", ",")
If s = k Then
i1 = i1 + 1
i3 = i3 + Len(s) + 1
Else
If i1 > 1 Then tmp.Characters(i2, i3).Font.ColorIndex = i1 + 1
i1 = 1
s = k
i2 = i2 + i3 + 1: i3 = Len(s)
End If
Next
Next
End Sub