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
Hi Domenic
Thanks for the quick response.

the code, only highlighted the last entries. Not the last two.

I will be using the values in column B and Dates in column C to write a formula so I want the last two entry for each value in column A to be next to each other.

sample of my data is:
A B C
IC54446 1258 24/01/2015
IC54446 1300 24/01/2015
IC54446 1258 24/03/2015
IC54446 1300 08/04/2015
AB2598 1800 15/06/2014
AB2598 1905 15/08/2014
AB2598 2001 15/08/2014
AB2598 2101 15/09/2014

thanks
 
Upvote 0
When I run the macro based on your sample data, I get the following results assuming that your data has column headers...

[TABLE="width: 192"]
<tbody>[TR]
[TD="class: xl63, width: 64"]AB2598[/TD]
[TD="class: xl63, width: 64, align: right"]2101[/TD]
[TD="class: xl64, width: 64, align: right"]9/15/14[/TD]
[/TR]
[TR]
[TD="class: xl63"]AB2598[/TD]
[TD="class: xl63, align: right"]1905[/TD]
[TD="class: xl64, align: right"]8/15/14[/TD]
[/TR]
[TR]
[TD="class: xl63"]IC54446[/TD]
[TD="class: xl63, align: right"]1300[/TD]
[TD="class: xl64, align: right"]4/08/15[/TD]
[/TR]
[TR]
[TD="class: xl63"]IC54446[/TD]
[TD="class: xl63, align: right"]1258[/TD]
[TD="class: xl64, align: right"]3/24/15[/TD]
[/TR]
</tbody>[/TABLE]

Is this the result you expect?

Also, are your dates true date values? If not, convert them into true date values.
 
Upvote 0
Hi Domenic
OK, the macro is working but not for all values.

when I run the macro on sample below I get this result.

Just a note, I am using Day, Month, Year format ( All our reports in Australia uses this format)



Result[TABLE="width: 217"]
<tbody>[TR]
[TD]ESR211[/TD]
[TD="align: right"]5474[/TD]
[TD="align: right"]7/01/2015[/TD]
[/TR]
[TR]
[TD]ESR211[/TD]
[TD="align: right"]5474[/TD]
[TD="align: right"]7/01/2015[/TD]
[/TR]
</tbody><colgroup><col span="2"><col></colgroup>[/TABLE]



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


Can you see what the problem is?

thanks
 
Upvote 0
The macro keeps the last two entries based solely on Column A, hence the result. Do you actually want base the results on both Column A and Column B? So the last two entries for Column A and Column B? If so, I'll have to get back to you when I get a chance. I'm logging off for the day.
 
Upvote 0
Try...

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]
    
    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("B1"), order2:=xlDescending, _
        key3:=Range("C1"), order3:=xlDescending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTop[color=darkblue]To[/color]Bottom
    
    Range(Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1)).FormulaR1C1 = "=RC1&""#""&RC2"
    
    [color=darkblue]For[/color] i = LastRow To 2 [color=darkblue]Step[/color] -1
        [color=darkblue]If[/color] WorksheetFunction.CountIf(Range(Cells(2, LastCol + 1), Cells(i, LastCol + 1)), Cells(i, LastCol + 1)) > 2 [color=darkblue]Then[/color]
            Rows(i).Delete
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i
    
    Columns(LastCol + 1).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
What is the result of the macro after you run it on the sample data that I gave earlier? I ran it and it is giving me the wrong results. it is not giving me the last two entries, rather leaving 4-5 rows at random. Maybe it is something that I'm doing.



It should give me below result:
[TABLE="class: 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]
[TR]
[TD][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
I get the following result...

[TABLE="width: 192"]
<colgroup><col style="width:48pt" span="3" width="64"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 64"]ESR211[/TD]
[TD="class: xl63, width: 64, align: right"]5474[/TD]
[TD="class: xl63, width: 64, align: right"]42011[/TD]
[/TR]
[TR]
[TD="class: xl63"]ESR211[/TD]
[TD="class: xl63, align: right"]5474[/TD]
[TD="class: xl63, align: right"]42011[/TD]
[/TR]
[TR]
[TD="class: xl63"]ESR211[/TD]
[TD="class: xl63, align: right"]5240[/TD]
[TD="class: xl63, align: right"]41880[/TD]
[/TR]
[TR]
[TD="class: xl63"]ESR211[/TD]
[TD="class: xl63, align: right"]5240[/TD]
[TD="class: xl63, align: right"]41880[/TD]
[/TR]
[TR]
[TD="class: xl63"]ESR211[/TD]
[TD="class: xl63, align: right"]4910[/TD]
[TD="class: xl63, align: right"]41722[/TD]
[/TR]
[TR]
[TD="class: xl63"]ESR211[/TD]
[TD="class: xl63, align: right"]4910[/TD]
[TD="class: xl63, align: right"]41722[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Can you modify the VBA code so it gives me the result that I want? thanks for your help

[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]
[TR]
[TD][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Moe Kadhom said:
Can you modify the VBA code so it gives me the result that I want? thanks for your help

[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]
[TR]
[TD][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...

Are you saying that these two rows above is what you expect?
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
Macro to filter Table to look for duplicates and delete older Entries
Replies
3
Views
78
Luke1690
L
D
  • Question Question
Data Validation List without duplicates
2 3 4
Replies
30
Views
993
kvsrinivasamurthy
K
B
  • Solved
Rate/Day over X Most Recent Entries
Replies
6
Views
210
Eric W
Eric W
L
  • Question Question
Macro to correct entries across multiple sheets
Replies
1
Views
291
Lux Aeterna
L
P
  • Question Question
For Each Loop with copy and paste over multiple worksheets
Replies
1
Views
150
Sam_D_Ben
Sam_D_Ben

Forum statistics

Threads
1,226,771
Messages
6,192,924
Members
453,767
Latest member
922aloose

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