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

ayushdadhich11

New Member
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)
 

Peter_SSs

MrExcel MVP, Moderator
.. 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?
 
Last edited:

ayushdadhich11

New Member
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

New Member
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

Well-known Member
.

- 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.

Code:
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

MrExcel MVP, Moderator
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?
 

Some videos you may like

This Week's Hot Topics

  • Get External Data (long shot question!)
    This is likely a long shot but I am wondering if it is at all possible for Excel to somehow 'change' the contents of a URL that is being linked to...
  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • Cell Formatting
    Good Morning, I need to format a few different cells in the following manners: A1 has to always add a colon (:) after whatever is typed in by a...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • Workbook_Change stopped working !
    I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
Top