Sub ColorDupes()
Dim MyRange As Range
'Before running macro, select cells you want to apply macro to
Set MyRange = Selection
Application.ScreenUpdating = True
For Each c In MyRange
If WorksheetFunction.CountIf(MyRange, c.Value) > 1 Then
c.Interior.ColorIndex = 3 'Color red
Else
c.Interior.ColorIndex = 0 'No color
End If
Next c
Application.ScreenUpdating = True
End Sub
Sub ColorDupes()
Dim MyRange As Range
'Before running macro, select cells you want to apply macro to
Set MyRange = Selection
Application.ScreenUpdating = True
For Each c In MyRange
If c = c.Offset(1, 0) Or c = c.Offset(-1, 0) Then
c.Interior.ColorIndex = 3 'Color red
Else
c.Interior.ColorIndex = 0 'No color
End If
Next c
Application.ScreenUpdating = True
End Sub