VBA MACRO TO Keep duplicates BASED ON CONDITION (Remove duplicate if the duplicate count of a particular id is greater 12 times

[ayushdadhich11]

In a sheet some 6000 rows are there. Id's are repetitive with different dates. I just want that macro will check the no. of repetition of each id and if the repetition is more than 12 times then it should delete the oldest date. (It means 12 times repetition is fine. If an id is repeated 13 times then it should delete only one oldest data so that last 12 data will be in the file)

 

[DanteAmor]

Welcome to the forum.

Please coment:
- In which row the data starts
- In which column are the dates
- in which column are the Id's

 

[Peter_SSs]

.. if the repetition is more than 12 times then it should delete the oldest date. (It means 12 times repetition is fine. If an id is repeated 13 times then it should delete only one oldest data so that last 12 data will be in the file)

Welcome to the MrExcel board!

A further question. The blue part indicates delete a single row but the red part seems to indicate that you want a maximum of 12 of the one id.
So can you please clarify what should happen if the sheet contains 15 of the same id - delete the oldest one leaving 14 or delete the oldest 3 leaving 12?

 

[ayushdadhich11]

Hi DanteAmor,

Thank you for looking at this. I am sorry for replying late.

Please find the inline answers of your question.

- In which row the data starts - The data start from 3rd Row
- In which column are the dates - The dates are in 3rd Column
- in which column are the Id's - The Id's are in 1st column

Thanks
Ayush

 

[ayushdadhich11]

Welcome to the MrExcel board!

A further question. The blue part indicates delete a single row but the red part seems to indicate that you want a maximum of 12 of the one id.
So can you please clarify what should happen if the sheet contains 15 of the same id - delete the oldest one leaving 14 or delete the oldest 3 leaving 12?

Hi Peter,

Thank you for welcome and looking at this.
if the sheet contains 15 of the same id then it should delete the oldest 3 leaving 12. Please reply asap

Thank you for help in advance.

Regards
Ayush

 

[DanteAmor]

.

- In which row the data starts - The data start from 3rd Row
- In which column are the dates - The dates are in 3rd Column
- in which column are the Id's - The Id's are in 1st column

Hi @★ ayushdadhich11,

Try the following. I performed a test with 9,000 records and the result is immediate.

Sub Keep_duplicates()
  Dim sh As Worksheet, ky As Variant, lr As Long, lc As Long, i As Long, a
  Dim n As Long, l2 As Long, j As Long, m As Long, r As Range
  
  Application.SheetsInNewWorkbook = 1
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  Set sh = ActiveSheet
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  lr = sh.Range("A" & Rows.Count).End(xlUp).Row
  lc = sh.Cells(3, Columns.Count).End(xlToLeft).Column
  sh.Range("A3", sh.Cells(lr, lc)).Sort key1:=sh.Range("C3"), order1:=xlDescending, Header:=xlNo
  a = sh.Range("A3:A" & lr)
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(a)
      .Item(a(i, 1)) = Empty
    Next
    For Each ky In .Keys
      n = WorksheetFunction.CountIf(Range("A3:A" & lr), ky)
      If n > 12 Then
        m = n - 12
        sh.Range("A3").AutoFilter 1, ky
        l2 = sh.Range("A" & Rows.Count).End(xlUp).Row
        Set r = Range("A" & l2 + 1)
        For j = l2 To 3 Step -1
          If m = 0 Then Exit For
          If sh.Range("A" & j).EntireRow.Hidden = False Then
            Set r = Union(r, Range("A" & j))
            m = m - 1
          End If
        Next
        r.EntireRow.Delete
      End If
    Next
  End With
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  sh.Range("A3", sh.Cells(lr, lc)).Sort key1:=sh.Range("A3"), order1:=xlAscending, Header:=xlNo
End Sub

 

[Peter_SSs]

if the sheet contains 15 of the same id then it should delete the oldest 3 leaving 12.

OK, thanks.

Dante has already made a suggestion but if there are any issues with that suggestion, then you might answer a few more from me.

1. Dante's code sorts your data. That may or may not alter the order of data on your sheet. If it does alter the order, is that a problem for you? Would you prefer to keep the data in its original order, apart from any deletions that is?

2. Speaking of order ..
a) Is your data sorted in any particular way? If so, details please.
b) Are rows for a particular ID grouped together or can they be spread throughout the data?
c) Are the oldest/newest dates for a particular ID always above/below other rows for that ID? That is, if I look for the first occurrence of a particular ID in column A, can I be sure that column C is either the oldest or the newest date for that ID?