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

 

[DanteAmor]

Hi and welcome to MrExcel!

I'm not sure what a "triplicate" is for you. In the following example, 10 is "duplicate" with 6 and also "duplicate" with 11.
So 10 is "triplicate"? and 6 and 11 only "duplicate"?

Dante Amor
	A		C							J							Q	R
1
2			1							100							6
3			10							120							1000
4			11							140							1100
5			30							160							1130
6			37							180							1160
7			44							200							1190
8
Sheet2

If the above is correct, try this macro:

Sub Duplicates_3()
  Dim c As Range, r As Range
  Dim dic1 As Object, dic2 As Object
  Dim j As Variant, ky As Variant
 
  Application.ScreenUpdating = False
  Set r = ActiveSheet.Range("C2:C7,J2:J7,Q2:Q7")
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
 
  r.Interior.ColorIndex = 19
  r.Font.Color = vbBlack
   
  For Each c In r
    dic2(c.Address) = c.Value
    For j = c.Value - 4 To c.Value + 4
      dic1(j) = dic1(j) + 1
    Next
  Next
  '
  For Each ky In dic2.keys
    j = dic1(dic2(ky))
    Select Case j
      Case 2
        Range(ky).Interior.ColorIndex = 3
        Range(ky).Font.Color = vbWhite
      Case Is >= 3
        Range(ky).Interior.ColorIndex = 10
        Range(ky).Font.Color = vbWhite
      Case 4
        '...
    End Select
  Next
End Sub

If all of the above is not correct, you could explain with examples when it is duplicated and when it is triplicated.

 

[Trotter]

I may have been unclear on my posting.
Duplicates and triplicates are defined in the macro posted.
As I said the macro for duplicates work. It is the additional formula to highlight triplicates that is a problem. It is the Triplicate part of the macro that is a problem.

Thanks for the reply

 

[Trotter]

With the macro I have the attached results.
It gives 6 defaults.
Everything have tried will change the defaults but still give 6 defaults

 

[Trotter]

I don't get replies on the forum, I only get a reply via email.
How do I correct this?

 

[Trotter]

The reason why I an using a macro is because the cells already have a formula to create them.

 

[DanteAmor]

As I said the macro for duplicates work. It is the additional formula to highlight triplicates that is a problem. It is the Triplicate part of the macro that is a problem.

In order to help you with "triplicates" I need to understand what a "triplicate" is for you.
Could you explain it with examples?

I don't get replies on the forum, I only get a reply via email.
How do I correct this?

Let's wait for a moderator to guide you.

With the macro I have the attached results.
It gives 6 defaults.
Everything have tried will change the defaults but still give 6 defaults

Which macro do you mean?
With that data sample, what are the correct results?

 

[DanteAmor]

Did you try my macro?

This is the result of my macro:

Dante Amor
	A		C	D						J	K						Q	R	S
1
2			98	D						40							60	T
3			35							22	T						80	D
4			22	T						95	D						2
5			80	D						24	T						16	D
6			122	D						121	D						15	D
7			63	T						140							59	T
8
Sheet2

 

[Trotter]

Hi Dante
Have tried your macro but get
Run-time error '429':
ActiveX component can't create object
It gets stuck on Set dic1 = CreateObject("Scripting.Dictionary")

 

[Trotter]

Hi Dante
Your macro works in Windows, but not on my Mac.
Any Ideas?