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

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
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

I haven't tested the following macro, but assuming that the sheet containing the data is the active sheet, the data starts at A1, and Row 1 contains column headers, try...

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

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

    [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, "C").End(xlUp).Row
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Range("A1", Cells(LastRow, LastCol)).Sort _
        key1:=Range("C1"), order1:=xlAscending, _
        key2:=Range("G1"), order2:=xlDescending, _
        Header:=xlYes, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTop[COLOR=darkblue]To[/COLOR]Bottom
    
    [COLOR=darkblue]For[/COLOR] i = LastRow To 2 [COLOR=darkblue]Step[/COLOR] -1
        [COLOR=darkblue]If[/COLOR] WorksheetFunction.CountIf(Range(Cells(2, "C"), Cells(i, "C")), Cells(i, "C")) > 1 [COLOR=darkblue]Then[/COLOR]
            Rows(i).Delete
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
    MsgBox "Completed...", vbInformation
        
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps!
 
Upvote 0
Hi Domenic,

It's specifically executed between 'C2:V573'. I tried to adjust your code to cater to it, but couldn't.

Thank you =}
 
Upvote 0
Just to be clear, C2:V573 contains your data? And which row contains your column headers?
 
Upvote 0
Thoroughness is always a good thing, I'll try and work on that one.


The header is located in the first row; in row (1) with the same columns C-V.

Where my data is then found in C2:V573.
 
Upvote 0
Try...

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

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

    [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, "C").End(xlUp).Row
    
    [COLOR=darkblue]With[/COLOR] Range("C1:V" & LastRow)
        .Sort _
            key1:=.Cells(1), order1:=xlAscending, _
            key2:=.Cells(1, 5), order2:=xlDescending, _
            Header:=xlYes, _
            OrderCustom:=1, _
            MatchCase:=False, _
            Orientation:=xlTop[COLOR=darkblue]To[/COLOR]Bottom
        [COLOR=darkblue]For[/COLOR] i = LastRow To 2 [COLOR=darkblue]Step[/COLOR] -1
            [COLOR=darkblue]If[/COLOR] WorksheetFunction.CountIf(Range(.Cells(2, 1), .Cells(i, 1)), .Cells(i, 1)) > 1 [COLOR=darkblue]Then[/COLOR]
                .Rows(i).Delete shift:=xlShiftUp
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]Next[/COLOR] i
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
    MsgBox "Completed...", vbInformation
        
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps!
 
Upvote 0
That's really good!

Now, can you add to your code for it to take the deleted duplicates MAX VALUES specifically between the Columns J-V?

(Column max # values for J,K,L,M,N,O,P,Q,R,S,T,U,V)

Please let me know, if you would like an example for my data source.

:)
 
Upvote 0
Hi Domenic,

Here my example is based on a sheet of which is comprised of 3 sets of data, so there will no be more than 3 duplicates displayed at any 1 time.

Where, I would like upon macro execution, is to delete a duplicate and for it to take its max values for its row between Columns J-V.


So in this example, all 3 duplicates are present at the time of macro execution;


[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Column C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[TD]K
[/TD]
[TD]L
[/TD]
[TD]M
[/TD]
[TD]N
[/TD]
[TD]O
[/TD]
[TD]P
[/TD]
[TD]Q
[/TD]
[TD]R
[/TD]
[TD]S
[/TD]
[TD]T
[/TD]
[TD]U
[/TD]
[TD]V
[/TD]
[/TR]
[TR]
[TD]XY 155
[/TD]
[TD]WWW
[/TD]
[TD]XY
[/TD]
[TD]155
[/TD]
[TD]1232
[/TD]
[TD]WWW
[/TD]
[TD]259
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[TD]2
[/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Column C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[TD]K
[/TD]
[TD]L
[/TD]
[TD]M
[/TD]
[TD]N
[/TD]
[TD]O
[/TD]
[TD]P
[/TD]
[TD]Q
[/TD]
[TD]R
[/TD]
[TD]S
[/TD]
[TD]T
[/TD]
[TD]U
[/TD]
[TD]V
[/TD]
[/TR]
[TR]
[TD]XY 155
[/TD]
[TD]WWW
[/TD]
[TD]XY
[/TD]
[TD]155
[/TD]
[TD]1232
[/TD]
[TD]WWW
[/TD]
[TD]259
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Column C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[TD]K
[/TD]
[TD]L
[/TD]
[TD]M
[/TD]
[TD]N
[/TD]
[TD]O
[/TD]
[TD]P
[/TD]
[TD]Q
[/TD]
[TD]R
[/TD]
[TD]S
[/TD]
[TD]T
[/TD]
[TD]U
[/TD]
[TD]V
[/TD]
[/TR]
[TR]
[TD]XY 155
[/TD]
[TD]WWW
[/TD]
[TD]XY
[/TD]
[TD]155
[/TD]
[TD]1232
[/TD]
[TD]WWW
[/TD]
[TD]259
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[TD]1
[/TD]
[/TR]
</tbody>[/TABLE]


Where after the macro it produces:

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Column C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[TD]K
[/TD]
[TD]L
[/TD]
[TD]M
[/TD]
[TD]N
[/TD]
[TD]O
[/TD]
[TD]P
[/TD]
[TD]Q
[/TD]
[TD]R
[/TD]
[TD]S
[/TD]
[TD]T
[/TD]
[TD]U
[/TD]
[TD]V
[/TD]
[/TR]
[TR]
[TD]XY 155
[/TD]
[TD]WWW
[/TD]
[TD]XY
[/TD]
[TD]155
[/TD]
[TD]1232
[/TD]
[TD]WWW
[/TD]
[TD]259
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[TD]3
[/TD]
[/TR]
</tbody>[/TABLE]


where you can see it takes the max values for the duplicate row between Columns J-V.

thank you
 
Last edited:
Upvote 0
Is this part in addition to the macro you already have? If not, there would be no need to sort by Column G, and so you can delete the following line...

Code:
key2:=.Cells(1, 5), order2:=xlDescending, _

Also, is the maximum value determined on a column-by-column basis? In other words, do we first look at Column J and take the maximum value from the 3 rows. And then we look at Column K and take the maximum value from the 3 rows, etc? Assuming that this is the case, try...

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

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

    [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]
    [COLOR=darkblue]Dim[/COLOR] j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    
    LastRow = Cells(Rows.Count, "C").End(xlUp).Row
    
    [COLOR=darkblue]With[/COLOR] Range("C1:V" & LastRow)
        .Sort _
            key1:=.Cells(1), order1:=xlAscending, _
            key2:=.Cells(1, 5), order2:=xlDescending, _
            Header:=xlYes, _
            OrderCustom:=1, _
            MatchCase:=False, _
            Orientation:=xlTop[COLOR=darkblue]To[/COLOR]Bottom
        [COLOR=darkblue]For[/COLOR] i = LastRow [COLOR=darkblue]To[/COLOR] 2 [COLOR=darkblue]Step[/COLOR] -1
            [COLOR=darkblue]If[/COLOR] WorksheetFunction.CountIf(Range(.Cells(2, 1), .Cells(i, 1)), .Cells(i, 1)) > 1 [COLOR=darkblue]Then[/COLOR]
                [COLOR=darkblue]For[/COLOR] j = 8 To 20
                    [COLOR=darkblue]If[/COLOR] .Cells(i, j).Value > .Cells(i - 1, j).Value [COLOR=darkblue]Then[/COLOR]
                        .Cells(i - 1, j).Value = .Cells(i, j).Value
                    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
                [COLOR=darkblue]Next[/COLOR] j
                .Rows(i).Delete shift:=xlShiftUp
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]Next[/COLOR] i
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
    MsgBox "Completed...", vbInformation
        
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps!
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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