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

rkol297

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!
 
Sort by date Sort by votes

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
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:
ESR211524029/08/2014
ESR21154747/01/2015

<tbody>
</tbody>

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

ESR21154741/07/15
ESR21152408/29/14

<tbody>
</tbody>

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
ABC
IC559930712/12/2013
IC559930712/12/2013
IC559930712/12/2013
IC559953608/04/2014
IC559953608/04/2014
IC559964902/06/2014
IC3094332425/11/2013
IC3094332425/11/2013
IC3094353119/03/2014
IC3094353119/03/2014
IC3094353119/03/2014
IC3094353119/03/2014
IC568859311/12/2013
IC568859311/12/2013
IC568859311/12/2013
IC568866410/04/2014
IC568866410/04/2014
IC568866410/04/2014
IC189970914/01/2014
IC189970914/01/2014
IC189970914/01/2014
IC189970914/01/2014
IC189970914/01/2014
IC189973404/06/2014
IC521336329/04/2014
IC521336329/05/2014
IC5213251714/08/2014
IC3771264507/02/2014
IC3771264507/02/2014
IC3771264507/02/2014
IC3771274016/05/2014
IC3771274016/05/2014
IC3766117820/03/2013
IC3766117820/03/2013
IC3766127906/03/2014
IC3766127906/03/2014
IC3766127906/03/2014
IC3766134223/06/2014

<tbody>
</tbody><colgroup><col><col><col></colgroup>
 
Upvote 0
Based on your sample data, can you post the result you expect?
 
Upvote 0
Result:
ABC
IC55995368/04/2014
IC55996492/06/2014
IC3094332425/11/2013
IC3094353119/03/2014
IC568859311/12/2013
IC568866410/04/2014
IC189970914/01/2014
IC18997344/06/2014
IC521336329/05/2014
IC5213251714/08/2014
IC377126457/02/2014
IC3771274016/05/2014
IC376612796/03/2014
IC3766134223/06/2014

<tbody>
</tbody><colgroup><col span="2"><col></colgroup>
 
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
This works great. You are a legend. Thanks for taking the time and working through my problem.
Much appreciated.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Check if duplicate projects with dates exist
Replies
2
Views
155
dubyarly
D
K
  • Solved
Identifying the duplicate id names with latest date by formula or VBA
Replies
2
Views
270
kismatstha
K
A
  • Question
Breaking up CSV files based on date into individual txt files
Replies
2
Views
251
anuradhagrewal
A
M
  • Question
VBA Code to copy rows by date from one tab to another / repeat based on new date
Replies
3
Views
294
kevin9999
K
M
  • Solved
VBA Help - Duplicate & Unwanted Data Removal
Replies
6
Views
190
MoonDancer
M

Forum statistics

Threads
1,215,988
Messages
6,128,144
Members
449,426
Latest member
revK

Share this page

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