Highlighting duplicates and triplicates

[Trotter]

I have a macro that works for duplicates with ranges that are not adjacent and with a tolerance value for the duplicate.



The second part of the macro is to highlight triplicates, which is where I am having problems.



This is one of many versions I have tried :





Sub Duplicates(r As Range)

Dim Cell

Application.ScreenUpdating = False

Set Dups1 = r

Set Dups2 = r



For Each c1 In Dups1

Duplicate = False

For Each c2 In r

If (c1.Address <> c2.Address) And c1.Value >= c2.Value And c1.Value < c2.Value + 5 Then

Duplicate = True

End If

Next c2

If Duplicate Then

c1.Interior.ColorIndex = 3

c1.Font.Color = vbWhite

Else

c1.Interior.ColorIndex = 19

c1.Font.ColorIndex = 1

End If

Next c1



For Each c2 In Dups2

Duplicate = False

For Each c1 In r

If (c1.Address <> c2.Address) And c1.Value >= c2.Value And c1.Value < c2.Value + 5 Then

Duplicate = True

End If

Next c1

If Duplicate Then

c2.Interior.ColorIndex = 3

c2.Font.Color = vbWhite

End If

Next c2

Application.ScreenUpdating = True

End Sub



Sub Triplicates(r As Range)

Dim Cell



Set Trips1 = r

Set Trips2 = r



For Each c1 In Trips1

Triplicate = False

For Each c2 In r

If c1.Interior.ColorIndex = c2.Interior.ColorIndex And (c1.Address <> c2.Address) And (c1.Value >= c2.Value) > 2 And c1.Value < c2.Value + 5 Then

Triplicate = True

End If

Next c2

If Triplicate Then

c1.Interior.ColorIndex = 10

End If

Next c1



For Each c2 In Trips2

Triplicate = False

For Each c1 In r

If c1.Interior.ColorIndex = c2.Interior.ColorIndex And (c1.Address <> c2.Address) And c1.Value >= c2.Value And c1.Value < c2.Value + 5 Then

Triplicate = True

End If

Next c1

If Triplicate Then

c2.Interior.ColorIndex = 10

End If

Next c2



End Sub



Sub Test()

ActiveSheet.Unprotect

Duplicates ActiveSheet.Range("C7:C12,J7:J12,Q7:Q12")

Triplicates ActiveSheet.Range("C7:C12,J7:J12,Q7:Q12")

ActiveSheet.Protect

End Sub

 

[Fluff]

Unfortunately you cannot use activeX components, like dictionaries on a Mac.

 

[DanteAmor]

Your macro works in Windows, but not on my Mac.

Unfortunately, I have no MAc, I have no way to test.