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
Joined
Sep 18, 2019
Messages
3
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)
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
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
 
Upvote 0
.. 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:
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
.

- 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
 
Upvote 0
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?
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,915
Members
448,532
Latest member
9Kimo3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top