Here's a good one! Delete duplicates with macro keeping only the newest by date

rkol297

Board Regular
Joined
Nov 12, 2010
Messages
131
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I have a spreedsheet with 17,000 rows in it. In column D I have ID numbers and in column B I have the dates. There are multiple entries for each ID in column D which gives multiples dates each entry was given in column B. I need a VBA Macro that will identify duplicate entries in Column D and keep only the most recent entry by date in column B. Any help would be greatly appreciated. I'm banging my head on the desk to get this to work thanks!
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Just to be clear, in addition to my previous post, can you also describe in words the logic that's involved?

I've got to get going for now, so I'll have to look at this when I get a chance.
 
Upvote 0
sorry, I should of been more clear. ignore what I said earlier as Im going to change what I want.


I want the macro to delete the duplicates in Column A but keep the last two values based on the latest dates in column C. There are some duplicate dates in column C.

So using my sample data:

Sample Data
ESR211 4910 12/12/2013
ESR211 4910 12/12/2013
ESR211 4910 24/03/2014
ESR211 4910 24/03/2014
ESR211 4910 24/03/2014
ESR211 5240 26/06/2014
ESR211 5240 4/07/2014
ESR211 5240 4/07/2014
ESR211 5240 29/08/2014
ESR211 5240 29/08/2014
ESR211 5240 29/08/2014
ESR211 5240 29/08/2014
ESR211 5474 7/01/2015
ESR211 5474 7/01/2015
ESR211 5474 7/01/2015


It should give me a result of:
[TABLE="class: cms_table_cms_table, width: 217"]
<tbody>[TR]
[TD]ESR211[/TD]
[TD="align: right"]5240[/TD]
[TD="align: right"]29/08/2014[/TD]
[/TR]
[TR]
[TD]ESR211[/TD]
[TD="align: right"]5474[/TD]
[TD="align: right"]7/01/2015[/TD]
[/TR]
</tbody>[/TABLE]

thanks
 
Upvote 0
Assuming that your table contains column headers, the macro produces the following result...

[TABLE="width: 192"]
<tbody>[TR]
[TD="class: xl65, width: 64"]ESR211[/TD]
[TD="class: xl65, width: 64, align: right"]5474[/TD]
[TD="class: xl66, width: 64, align: right"]1/07/15[/TD]
[/TR]
[TR]
[TD="class: xl65"]ESR211[/TD]
[TD="class: xl65, align: right"]5240[/TD]
[TD="class: xl66, align: right"]8/29/14[/TD]
[/TR]
</tbody>[/TABLE]

Code:
[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] KeepLastTwoUniqueEntries()

    [COLOR=darkblue]Dim[/COLOR] LastRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] LastCol [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] ActiveSheet
        [COLOR=darkblue]If[/COLOR] .FilterMode [COLOR=darkblue]Then[/COLOR] .ShowAllData
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Range("A1", Cells(LastRow, LastCol)).Sort _
        key1:=Range("A1"), order1:=xlAscending, _
        key2:=Range("C1"), order2:=xlDescending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom
    
    Range(Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1)).FormulaR1C1 = "=RC1&""#""&RC3"
    
    Cells(1, LastCol + 2).Value = 0
    Range(Cells(2, LastCol + 2), Cells(LastRow, LastCol + 2)).FormulaR1C1 = "=IF(COUNTIF(R2C[-1]:RC[-1],RC[-1])=1,LOOKUP(9.99999999999999E+307,R1C:R[-1]C)+1,"""")"
    
    [COLOR=darkblue]With[/COLOR] Range("A1", Cells(LastRow, LastCol + 2))
        .AutoFilter field:=LastCol + 2, Criteria1:="<>1", Operator:=xlAnd, Criteria2:="<>2"
        .Offset(1, 0).EntireRow.Delete
        .AutoFilter
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    Columns(LastCol + 1).Resize(, 2).ClearContents
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
    MsgBox "Completed...", vbInformation
        
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

If you so desire, the results can be sorted by date in ascending order.

Hope this helps!
 
Upvote 0
hi Domenic
This work great on my sample data, however, When I run the macro for all my data, the result only shows two entries of a random value in column A.
Below is a bigger sample data if it helps. I want the macro to delete the duplicates in Column A but keep the last two values based on the latest dates in column C. There are some duplicate dates in column C.

sorry if this seems to be dragging on, if its taking too much of your time don't worry about it. Ill just find another way.



Sample Data
[TABLE="width: 236"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]IC5599[/TD]
[TD="align: right"]307[/TD]
[TD="align: right"]12/12/2013[/TD]
[/TR]
[TR]
[TD]IC5599[/TD]
[TD="align: right"]307[/TD]
[TD="align: right"]12/12/2013[/TD]
[/TR]
[TR]
[TD]IC5599[/TD]
[TD="align: right"]307[/TD]
[TD="align: right"]12/12/2013[/TD]
[/TR]
[TR]
[TD]IC5599[/TD]
[TD="align: right"]536[/TD]
[TD="align: right"]08/04/2014[/TD]
[/TR]
[TR]
[TD]IC5599[/TD]
[TD="align: right"]536[/TD]
[TD="align: right"]08/04/2014[/TD]
[/TR]
[TR]
[TD]IC5599[/TD]
[TD="align: right"]649[/TD]
[TD="align: right"]02/06/2014[/TD]
[/TR]
[TR]
[TD]IC3094[/TD]
[TD="align: right"]3324[/TD]
[TD="align: right"]25/11/2013[/TD]
[/TR]
[TR]
[TD]IC3094[/TD]
[TD="align: right"]3324[/TD]
[TD="align: right"]25/11/2013[/TD]
[/TR]
[TR]
[TD]IC3094[/TD]
[TD="align: right"]3531[/TD]
[TD="align: right"]19/03/2014[/TD]
[/TR]
[TR]
[TD]IC3094[/TD]
[TD="align: right"]3531[/TD]
[TD="align: right"]19/03/2014[/TD]
[/TR]
[TR]
[TD]IC3094[/TD]
[TD="align: right"]3531[/TD]
[TD="align: right"]19/03/2014[/TD]
[/TR]
[TR]
[TD]IC3094[/TD]
[TD="align: right"]3531[/TD]
[TD="align: right"]19/03/2014[/TD]
[/TR]
[TR]
[TD]IC5688[/TD]
[TD="align: right"]593[/TD]
[TD="align: right"]11/12/2013[/TD]
[/TR]
[TR]
[TD]IC5688[/TD]
[TD="align: right"]593[/TD]
[TD="align: right"]11/12/2013[/TD]
[/TR]
[TR]
[TD]IC5688[/TD]
[TD="align: right"]593[/TD]
[TD="align: right"]11/12/2013[/TD]
[/TR]
[TR]
[TD]IC5688[/TD]
[TD="align: right"]664[/TD]
[TD="align: right"]10/04/2014[/TD]
[/TR]
[TR]
[TD]IC5688[/TD]
[TD="align: right"]664[/TD]
[TD="align: right"]10/04/2014[/TD]
[/TR]
[TR]
[TD]IC5688[/TD]
[TD="align: right"]664[/TD]
[TD="align: right"]10/04/2014[/TD]
[/TR]
[TR]
[TD]IC1899[/TD]
[TD="align: right"]709[/TD]
[TD="align: right"]14/01/2014[/TD]
[/TR]
[TR]
[TD]IC1899[/TD]
[TD="align: right"]709[/TD]
[TD="align: right"]14/01/2014[/TD]
[/TR]
[TR]
[TD]IC1899[/TD]
[TD="align: right"]709[/TD]
[TD="align: right"]14/01/2014[/TD]
[/TR]
[TR]
[TD]IC1899[/TD]
[TD="align: right"]709[/TD]
[TD="align: right"]14/01/2014[/TD]
[/TR]
[TR]
[TD]IC1899[/TD]
[TD="align: right"]709[/TD]
[TD="align: right"]14/01/2014[/TD]
[/TR]
[TR]
[TD]IC1899[/TD]
[TD="align: right"]734[/TD]
[TD="align: right"]04/06/2014[/TD]
[/TR]
[TR]
[TD]IC5213[/TD]
[TD="align: right"]363[/TD]
[TD="align: right"]29/04/2014[/TD]
[/TR]
[TR]
[TD]IC5213[/TD]
[TD="align: right"]363[/TD]
[TD="align: right"]29/05/2014[/TD]
[/TR]
[TR]
[TD]IC5213[/TD]
[TD="align: right"]2517[/TD]
[TD="align: right"]14/08/2014[/TD]
[/TR]
[TR]
[TD]IC3771[/TD]
[TD="align: right"]2645[/TD]
[TD="align: right"]07/02/2014[/TD]
[/TR]
[TR]
[TD]IC3771[/TD]
[TD="align: right"]2645[/TD]
[TD="align: right"]07/02/2014[/TD]
[/TR]
[TR]
[TD]IC3771[/TD]
[TD="align: right"]2645[/TD]
[TD="align: right"]07/02/2014[/TD]
[/TR]
[TR]
[TD]IC3771[/TD]
[TD="align: right"]2740[/TD]
[TD="align: right"]16/05/2014[/TD]
[/TR]
[TR]
[TD]IC3771[/TD]
[TD="align: right"]2740[/TD]
[TD="align: right"]16/05/2014[/TD]
[/TR]
[TR]
[TD]IC3766[/TD]
[TD="align: right"]1178[/TD]
[TD="align: right"]20/03/2013[/TD]
[/TR]
[TR]
[TD]IC3766[/TD]
[TD="align: right"]1178[/TD]
[TD="align: right"]20/03/2013[/TD]
[/TR]
[TR]
[TD]IC3766[/TD]
[TD="align: right"]1279[/TD]
[TD="align: right"]06/03/2014[/TD]
[/TR]
[TR]
[TD]IC3766[/TD]
[TD="align: right"]1279[/TD]
[TD="align: right"]06/03/2014[/TD]
[/TR]
[TR]
[TD]IC3766[/TD]
[TD="align: right"]1279[/TD]
[TD="align: right"]06/03/2014[/TD]
[/TR]
[TR]
[TD]IC3766[/TD]
[TD="align: right"]1342[/TD]
[TD="align: right"]23/06/2014[/TD]
[/TR]
</tbody><colgroup><col><col><col></colgroup>[/TABLE]
 
Upvote 0
Based on your sample data, can you post the result you expect?
 
Upvote 0
Result:
[TABLE="width: 203"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]IC5599[/TD]
[TD="align: right"]536[/TD]
[TD="align: right"]8/04/2014[/TD]
[/TR]
[TR]
[TD]IC5599[/TD]
[TD="align: right"]649[/TD]
[TD="align: right"]2/06/2014[/TD]
[/TR]
[TR]
[TD]IC3094[/TD]
[TD="align: right"]3324[/TD]
[TD="align: right"]25/11/2013[/TD]
[/TR]
[TR]
[TD]IC3094[/TD]
[TD="align: right"]3531[/TD]
[TD="align: right"]19/03/2014[/TD]
[/TR]
[TR]
[TD]IC5688[/TD]
[TD="align: right"]593[/TD]
[TD="align: right"]11/12/2013[/TD]
[/TR]
[TR]
[TD]IC5688[/TD]
[TD="align: right"]664[/TD]
[TD="align: right"]10/04/2014[/TD]
[/TR]
[TR]
[TD]IC1899[/TD]
[TD="align: right"]709[/TD]
[TD="align: right"]14/01/2014[/TD]
[/TR]
[TR]
[TD]IC1899[/TD]
[TD="align: right"]734[/TD]
[TD="align: right"]4/06/2014[/TD]
[/TR]
[TR]
[TD]IC5213[/TD]
[TD="align: right"]363[/TD]
[TD="align: right"]29/05/2014[/TD]
[/TR]
[TR]
[TD]IC5213[/TD]
[TD="align: right"]2517[/TD]
[TD="align: right"]14/08/2014[/TD]
[/TR]
[TR]
[TD]IC3771[/TD]
[TD="align: right"]2645[/TD]
[TD="align: right"]7/02/2014[/TD]
[/TR]
[TR]
[TD]IC3771[/TD]
[TD="align: right"]2740[/TD]
[TD="align: right"]16/05/2014[/TD]
[/TR]
[TR]
[TD]IC3766[/TD]
[TD="align: right"]1279[/TD]
[TD="align: right"]6/03/2014[/TD]
[/TR]
[TR]
[TD]IC3766[/TD]
[TD="align: right"]1342[/TD]
[TD="align: right"]23/06/2014[/TD]
[/TR]
</tbody><colgroup><col span="2"><col></colgroup>[/TABLE]
 
Upvote 0
The following macro should return the desired result, as per your last post...

Code:
[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] KeepLastTwoEntries()

    [COLOR=darkblue]Dim[/COLOR] LastRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] LastCol [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] ActiveSheet
        [COLOR=darkblue]If[/COLOR] .FilterMode [COLOR=darkblue]Then[/COLOR] .ShowAllData
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    [COLOR=darkblue]With[/COLOR] Range(Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1))
        .FormulaR1C1 = "=ROW()"
        .Value = .Value
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    Range("A1", Cells(LastRow, LastCol + 1)).Sort _
        key1:=Range("A1"), order1:=xlAscending, _
        key2:=Range("C1"), order2:=xlDescending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom
    
    [COLOR=darkblue]With[/COLOR] Cells(2, LastCol + 2)
        .FormulaArray = "=IF(COUNTIF($A$2:A2,A2)=1,""x"",IF(ROWS($A$2:A2)=MATCH(1,IF($A$2:A2=A2,IF($C$2:C2<>INDEX($C$2:C2,MATCH(A2,$A$2:A2,0)),1)),0),""x"",""""))"
        .Copy Range(Cells(3, LastCol + 2), Cells(LastRow, LastCol + 2))
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] Range("A1", Cells(LastRow, LastCol + 2))
        .AutoFilter field:=LastCol + 2, Criteria1:="<>x"
        .Offset(1, 0).EntireRow.Delete
        .AutoFilter
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    Range("A1", Cells(LastRow, LastCol + 2)).Sort _
        key1:=Cells(1, LastCol + 1), order1:=xlAscending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom
    
    Columns(LastCol + 1).Resize(, 2).ClearContents
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
    MsgBox "Completed...", vbInformation
        
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps!
 
Upvote 0
Hi Domenic,

I also have a spread sheet with 573 rows in it.

In column C I have ID numbers and in column G I have the time.

There are multiple entries for each ID in column C which gives multiples times each entry was given in column G.

I need a VBA Macro that will identify duplicate entries in Column C and keep only the most recent entry by time in column G.

Any help would be greatly appreciated, thanks!

-Pinaceous
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,100
Members
452,301
Latest member
QualityAssurance

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