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

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Pinaceous said:
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
Click to expand...

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;


Column C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
S
T
U
V
XY 155
WWW
XY
155
1232
WWW
259
2
2
2
2
2
2
2
2
2
2
2
2
2

<tbody>
</tbody>


Column C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
S
T
U
V
XY 155
WWW
XY
155
1232
WWW
259
3
3
3
3
3
3
3
3
3
3
3
3
3

<tbody>
</tbody>


Column C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
S
T
U
V
XY 155
WWW
XY
155
1232
WWW
259
1
1
1
1
1
1
1
1
1
1
1
1
1

<tbody>
</tbody>


Where after the macro it produces:

Column C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
S
T
U
V
XY 155
WWW
XY
155
1232
WWW
259
3
3
3
3
3
3
3
3
3
3
3
3
3

<tbody>
</tbody>


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
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
250
anuradhagrewal
A
M
  • Question
VBA Code to copy rows by date from one tab to another / repeat based on new date
Replies
3
Views
293
kevin9999
K
M
  • Solved
VBA Help - Duplicate & Unwanted Data Removal
Replies
6
Views
187
MoonDancer
M

Forum statistics

Threads
1,215,972
Messages
6,128,011
Members
449,414
Latest member
sameri

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