Locate Values that are shown 3 or more times

[bad Santa]

Looking for help identifying items that appear 3 or more times. I found this online and have spent two days trying to adjust it. How would I change this VBA to identify only items that appear 3 or more times instead of tow times.

Please help and thank you




Sub sbFindDuplicatesInColumn()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
Dim Occurances As Long

lastRow = Range("A65000").End(xlUp).Row

For iCntr = 1 To lastRow
If Cells(iCntr, 1) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 2) = "Duplicate"
End If
End If
Next
End Sub

 

[Crystalyzer]

Does this have to be a VBA solution? You can achieve this with conditional formatting

Book2
	J
6	A
7	B
8	A
9	B
10	C
11	C
12	A
13	D
14	E
15	F
16	F
17	F
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
J6:J17	Expression	=COUNTIF($J$6:$J$17,"="&J6)>=3	text	NO

 

[JamesCanale]

Or get a list:

Mr Excel Playground 3.xlsm
	A	B	C	D
1	a	3		a
2	b	4		b
3	c	1		m
4	d	1
5	e	1
6	f	1
7	b	4
8	g	1
9	h	1
10	b	4
11	j	1
12	k	1
13	a	3
14	l	1
15	m	4
16	n	1
17	a	3
18	b	4
19	m	4
20	m	4
21	m	4
Sheet11

Cell Formulas
Range	Formula
D1:D3	D1	=INDEX(UNIQUE(FILTER(A1:B21,B1:B21>2)),,1)
B1:B21	B1	=SUM(--($A$1:$A$21=A1))
Dynamic array formulas.

 

[bad Santa]

I would prefer VBA to make it simple for others to use.

 

[Crystalyzer]

Nothing simpler than the data self analyzing in this case without having to go run a macro. Could also have a formula fill in the cells that you are filling in with your code.

Book2
	J	K
6	A	Duplicate
7	B
8	A	Duplicate
9	B
10	C
11	C
12	A	Duplicate
13	D
14	E
15	F	Duplicate
16	F	Duplicate
17	F	Duplicate
Sheet1

Cell Formulas
Range	Formula
K6:K17	K6	=IF(COUNTIF($J$6:$J$17,"="&J6)>2,"Duplicate","")

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
J6:J17	Expression	=COUNTIF($J$6:$J$17,"="&J6)>=3	text	NO

 

[bad Santa]

So is there nothing I can add to the Macro to make this work?

 

[Eric W]

Seriously, Conditional Formatting is easiest. Do you have some other process, possibly manual, that requires looking for the "Duplicate" values? If so, we can probably find a way to incorporate that. But if you really just want an updated macro, try this:

Sub sbFindDuplicatesInColumn()
Dim myData As Variant, i As Long, lr As Long, myDict As Object, TopCell As Range, Out As Range

    Set TopCell = Range("A1")
    
    lr = Cells(Rows.Count, TopCell.Column).End(xlUp).Row
    myData = TopCell.Resize(lr).Value
    Set myDict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(myData)
        myDict(myData(i, 1)) = myDict(myData(i, 1)) + 1
        If myDict(myData(i, 1)) >= 3 Then
            If Out Is Nothing Then
                Set Out = TopCell.Offset(i - 1, 2)
            Else
                Set Out = Union(Out, TopCell.Offset(i - 1, 2))
            End If
        End If
    Next i
    If Not Out Is Nothing Then Out.Value = "Duplicate"
    
End Sub