Find x number of duplicates and highlight duplicates rows

[DBjjprint]

Need a macro to find greater the 5 duplicates in a target field and highlight rows or just the target field
I am doing this manually with Countif and Conditional formatting rules but I can not get a macro to work
Duplicates are always consecutive
This is the data

plus 5 dupes.xlsx
	A	B	C
1	FIRST_NAME	LAST_NAME	ACCOUNT_NBR
2			123
3			123
4			123
5			12
6			12
7			123456
8			123456
9			123456
10			123456
11			123456
12			123456
13			1234
14			1234
15			1234
16			1234
17			12345678
18			12345678
19			12345678
20			12345678
21			12345678
22			12345678
23			12345678
24			12345678
Export

This is the needed results

plus 5 dupes.xlsx
	A	B	C
1	FIRST_NAME	LAST_NAME	ACCOUNT_NBR
2			123
3			123
4			123
5			12
6			12
7			123456
8			123456
9			123456
10			123456
11			123456
12			123456
13			1234
14			1234
15			1234
16			1234
17			12345678
18			12345678
19			12345678
20			12345678
21			12345678
22			12345678
23			12345678
24			12345678
Export

 

[Eric W]

Try:

Sub FiveInAColumn()
Dim MyRange As Range, OutRange As Range
Dim d As Variant, r As Long, i As Long, NumRows As Long

    NumRows = 5
    Set MyRange = Range("C2:C24")
    Set OutRange = Nothing
    
    d = MyRange.Value
    For r = 1 To UBound(d) - NumRows + 1
        For i = 1 To NumRows - 1
            If d(r, 1) <> d(r + i, 1) Then GoTo Nope:
        Next i
            
        If OutRange Is Nothing Then
            Set OutRange = MyRange.Offset(r - 1).Resize(NumRows)
        Else
            Set OutRange = Union(OutRange, MyRange.Offset(r - 1).Resize(NumRows))
        End If
Nope:
    Next r
    
    OutRange.Interior.Color = vbYellow
            
End Sub

 

[DBjjprint]

Thanks for the quick response
This works perfect, just made a couple of modification
Change NumRows to 6, needed to highlight greater than 5, but the code makes it easy to adjust to highlight whatever number of duplicates needed
Then the Range set to C2:C3000 to cover 150 excel files I have to apply this to
Thank you

 

[Eric W]

Happy to help!

 

[DBjjprint]

I need a modification on the above code, need to delete all the other rows that are not highlighted duplicates
Not sure why i didn't think of this before so I don't have to search rows of data to find highlight cells

 

[Eric W]

This should work. Test it on a COPY of your data. It will delete rows and there will be no way to undo it.

Sub FiveInAColumn()
Dim MyRange As Range, OutRange As Range, DelRange As Range
Dim d As Variant, r As Long, i As Long, NumRows As Long, c As Variant

    NumRows = 5
    Set MyRange = Range("C2:C24")
    Set OutRange = Nothing
    Set DelRange = Nothing
    
    d = MyRange.Value
    For r = 1 To UBound(d) - NumRows + 1
        For i = 1 To NumRows - 1
            If d(r, 1) <> d(r + i, 1) Then GoTo Nope:
        Next i
            
        If OutRange Is Nothing Then
            Set OutRange = MyRange.Offset(r - 1).Resize(NumRows)
        Else
            Set OutRange = Union(OutRange, MyRange.Offset(r - 1).Resize(NumRows))
        End If
Nope:
    Next r
    
    OutRange.Interior.Color = vbYellow

    For Each c In MyRange
        If Intersect(c, OutRange) Is Nothing Then
            If DelRange Is Nothing Then
                Set DelRange = c.EntireRow
            Else
                Set DelRange = Union(DelRange, c.EntireRow)
            End If
        End If
    Next c
    
    DelRange.Delete shift:=xlUp
    
End Sub

 

[DBjjprint]

Thank you again that works great