Looking to remove duplicates based on a date criteria

DJMCCOURT

New Member
Joined
Jul 4, 2019
Messages
14
Hi There,

I am looking for a macro to sort a whole sheet on one column in order A-Z then to remove lines if data in that column has duplicate information in it but then i would like it to remove the later entry or entries based on a date.

So the column i want it to sort on is Column D "17 Digit Chassis No" then leave only the earliest dated record based on the date in Column H "Purch/Add Date".

I have tried to decipher other macros on here to suit my criteria but i have failed miserably each time, but you cant blame a guy for trying!!

Could anyone assist please?

SAMPLE DATA BELOW (Cant seem to get it into a table on the forum, im obviously missing something.

Batch NoMakeModel17 Digit Chassis NoRegistration Date
(DD/MM/YYYY)
Stock NumberBranchPurch/Add Date
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603610630/05/2019208692AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603612530/05/2019208693AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603620730/05/2019208708AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603621030/05/2019208684AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603624530/05/2019208690AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603641130/05/2019208689AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603641230/05/2019208705AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603643530/05/2019208699AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603653730/05/2019208698AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603660230/05/2019208685AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603661630/05/2019208707AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603662630/05/2019208704AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603663530/05/2019208706AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603665330/05/2019208697AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603674230/05/2019208703AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603675930/05/2019208753AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603681230/05/2019208741AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603684430/05/2019208686AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603686330/05/2019208754AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603686430/05/2019208747AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603688730/05/2019208701AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603699530/05/2019208696AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603705530/05/2019208702AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603706030/05/2019208695AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603706130/05/2019208700AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603707030/05/2019208742AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603709330/05/2019208761AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603709730/05/2019208764AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603711930/05/2019208687AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603725830/05/2019208680AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603727730/05/2019208743AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603734130/05/2019208745AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603735930/05/2019208734AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603737030/05/2019208752AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603759230/05/2019208677AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603763830/05/2019208759AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603767930/05/2019208736AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603775130/05/2019208756AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603777430/05/2019208739AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603781930/05/2019208762AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603783930/05/2019208788AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603786930/05/2019208740AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603789030/05/2019208749AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603792630/05/2019208744AU23/04/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603699530/05/20198415FE28/06/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603706030/05/20198414FE28/06/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603734130/05/20193190FS28/06/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603709730/05/20194390GB28/06/2019
VX65VauxhallVauxhall Adam Hatchback Special Ed 1.2i Energised 3drW0V0MAP08K603660230/05/201912601GU28/06/2019

<colgroup><col width="64" span="8" style="width:48pt"> </colgroup><tbody>
</tbody>



Thanks
Dave
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
the post#5 is very small and it is difficult to notice :LOL:

so try PowerQuery aka Get&Transform

Code:
[SIZE=1]// Table1
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Type = Table.TransformColumnTypes(Source,{{"Batch No", type text}, {"Make", type text}, {"Model", type text}, {"17 Digit Chassis No", type text}, {"Registration Date ", type date}, {"Stock Number", Int64.Type}, {"Branch", type text}, {"Purch/Add Date", type date}}),
    SortDate = Table.Sort(Type,{{"Purch/Add Date", Order.Descending}}),
    DeDup = Table.Distinct(SortDate, {"17 Digit Chassis No"}),
    SortChassis = Table.Sort(DeDup,{{"17 Digit Chassis No", Order.Ascending}})
in
    SortChassis[/SIZE]

and file with your example
 
Last edited:
Upvote 0
@DJMCCOURT
I think you may have been referring to sandy666's response.

Try this version of the macro:
Code:
Sub DeleteDups()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, RngList As Object, item As Variant, fRow As Long, lRows As Long, rCount As Long
    Set ws = Sheets("BAT")
    LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With ws.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("D1:D" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("H1:H" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:H" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each Rng In ws.Range("D2", ws.Range("D" & ws.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Rng.Row
        End If
    Next
    MsgBox RngList.Count
    For Each item In RngList
        With ws.Cells(1).CurrentRegion
            .AutoFilter 4, item
            rCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
            fRow = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
            lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            If lRow > fRow And rCount > 1 Then
                ws.Rows(fRow + 1 & ":" & lRow).EntireRow.Delete
            End If
        End With
    Next item
    ws.Cells(1).AutoFilter
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
the post#5 is very small and it is difficult to notice :LOL:

so try PowerQuery aka Get&Transform

Code:
[SIZE=1]// Table1
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Type = Table.TransformColumnTypes(Source,{{"Batch No", type text}, {"Make", type text}, {"Model", type text}, {"17 Digit Chassis No", type text}, {"Registration Date ", type date}, {"Stock Number", Int64.Type}, {"Branch", type text}, {"Purch/Add Date", type date}}),
    SortDate = Table.Sort(Type,{{"Purch/Add Date", Order.Descending}}),
    DeDup = Table.Distinct(SortDate, {"17 Digit Chassis No"}),
    SortChassis = Table.Sort(DeDup,{{"17 Digit Chassis No", Order.Ascending}})
in
    SortChassis[/SIZE]

and file with your example


Hi sandy666, being a novice to this, where do i paste that code? into a new module or.....

Also when i download the file, that sheet doesnt have the macro in it that i can see? Should it, or am i missing something here?

Thanks
Dave
 
Upvote 0
this is not a vba but PowerQuery M-code

in the file
Ribbon - Data - Show Queries - double click on table on the right side - on the ribbon from new window find Advanced Editor then you'll see M-code

easier way
select your whole range with data (without empty rows!) and from Data tab choose From Table, first copy code from the post and replace with code in Advanced Editor
make sure the name of your source table is the same as in the code

you did not say what version of excel you use so it's hard to find details or even if it works for you
 
Last edited:
Upvote 0
I've to go but if you've a problem with M-code and PowerQuery you can always use mumps's vba (with all due respect mumps :) )
 
Upvote 0

Forum statistics

Threads
1,215,480
Messages
6,125,053
Members
449,206
Latest member
Healthydogs

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