Remove Duplicates - first instance

[Afro_Cookie]

I am populating data from a seporate workbook and there are duplicates that get transefered over in the process. I want to remove the duplicates, but keep the last entry. All the removal processes I've seen remove the first instance only, or require additional steps of adding columns to create a unique value and then delete the values and columns each time.

Is there a way to run through my table and based on Column A, delete duplicates, but keep the data in the lowest row/ highest numbered row? Or a reverse lookup, duplicate removal?

 

[Afro_Cookie]

I'm not too fluent in Spanish so I used Google to translate, and here is an example of the table. In the end I would only want to show items: 3,9,10,11,12,13,15,16,17,18,19 left over.

Item	Description	Delivery Date	Qty	Status
1	T1	7/7/2023	72,000	N
2	T1	7/28/2023	90,000	N
3	T1	7/28/2023	1,248	N
4	T2	7/28/2023	1,248	Y
5	T3	8/4/2023	1,248	Y
6	T7	8/4/2023	1,248	B
7	T7	8/4/2023	1,248	Y
8	T7	8/4/2023	1,248	Y
9	T7	8/4/2023	1,248	Y
10	T2	8/4/2023	1,248	N
11	T3	8/4/2023	1,248	A
12	T4	8/4/2023	1,248	N
13	T5	8/4/2023	1,248	N
14	T100	8/4/2023	1,248	N
15	T50	8/4/2023	1,248	N
16	Tan	8/4/2023	1,248	Y
17	Tbc	8/4/2023	1,248	Y
18	Tbc	8/4/2023	1,248	N
19	T100	8/4/2023	1,248	N

 

[JoeMo]

Assuming you want to remove duplicates from Col B, top down, I don't think your list of item numbers should include 17 as its col B value of Tbc is duplicated by 18.
Here's a macro that should produce your desired output in cols G:K sorted on "Item".

Sub DeleteDupsFromTop()
'Deletes dups from col B from top down
Dim sn, j As Long
sn = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value
With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)  'put each row into a dictionary item using first column data which has the dups
        .Item(sn(j, 2)) = Application.Index(sn, j, 0)
    Next
    'Write edited (dup free in col A) list from cols A:E to cols G:K
    Range("G1:K1").Value = Range("A1:E1").Value
    Columns("G").Cells(2, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
    Range("G1").CurrentRegion.Sort key1:=[G2], order1:=xlAscending, Header:=xlYes
End With
End Sub

 

[Afro_Cookie]

Assuming you want to remove duplicates from Col B, top down, I don't think your list of item numbers should include 17 as its col B value of Tbc is duplicated by 18.
Here's a macro that should produce your desired output in cols G:K sorted on "Item".

Sub DeleteDupsFromTop()
'Deletes dups from col B from top down
Dim sn, j As Long
sn = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value
With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)  'put each row into a dictionary item using first column data which has the dups
        .Item(sn(j, 2)) = Application.Index(sn, j, 0)
    Next
    'Write edited (dup free in col A) list from cols A:E to cols G:K
    Range("G1:K1").Value = Range("A1:E1").Value
    Columns("G").Cells(2, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
    Range("G1").CurrentRegion.Sort key1:=[G2], order1:=xlAscending, Header:=xlYes
End With
End Sub

This does work in duplicating the data without the duplicates, but I then have to clear the initial data and transfer the filtered data into the original location.

Is there a way to delete the entire rows for the first duplicate entries?

 

[JoeMo]

This does work in duplicating the data without the duplicates, but I then have to clear the initial data and transfer the filtered data into the original location.

Is there a way to delete the entire rows for the first duplicate entries?

See if this does what you want:

Sub DeleteDupsFromTop2()
'Deletes dups from col B from top down
Dim sn, j As Long
sn = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value
With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)  'put each row into a dictionary item using second column data which has the dups
        .Item(sn(j, 2)) = Application.Index(sn, j, 0)
    Next
    'Write edited (dup free in col A) list back to cols A:E
    Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Clear
    Range("A2").Cells(1, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
    Range("A1").CurrentRegion.Sort key1:=[A2], order1:=xlAscending, Header:=xlYes
End With
End Sub

 

[kevin9999]

Another option...

Option Explicit
Sub Keep_Last_Duplicate()
    Dim ws As Worksheet, r As Range, LRow As Long, LCol As Long
    Set ws = Worksheets("Sheet1")   '<~~ *** Change sheet name to suit ***
    Set r = ws.Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    LRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    LCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Dim a, b, i As Long
    
    a = ws.Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 1) <> WorksheetFunction.MaxIfs(r.Columns(1), r.Columns(2), a(i, 2)) Then b(i, 1) = 1
    Next i
    ws.Cells(2, LCol).Resize(UBound(b, 1)).Value = b
    
    i = WorksheetFunction.Sum(ws.Columns(LCol))
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, LCol).Resize(i).EntireRow.Delete
    End If
End Sub

 

[Afro_Cookie]

Another option...

Option Explicit
Sub Keep_Last_Duplicate()
    Dim ws As Worksheet, r As Range, LRow As Long, LCol As Long
    Set ws = Worksheets("Sheet1")   '<~~ *** Change sheet name to suit ***
    Set r = ws.Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    LRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    LCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    Dim a, b, i As Long
   
    a = ws.Range("A2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 1) <> WorksheetFunction.MaxIfs(r.Columns(1), r.Columns(2), a(i, 2)) Then b(i, 1) = 1
    Next i
    ws.Cells(2, LCol).Resize(UBound(b, 1)).Value = b
   
    i = WorksheetFunction.Sum(ws.Columns(LCol))
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, LCol).Resize(i).EntireRow.Delete
    End If
End Sub

Thanks Kevin, this option always works. Appreciate your help

 

[Afro_Cookie]

See if this does what you want:

Sub DeleteDupsFromTop2()
'Deletes dups from col B from top down
Dim sn, j As Long
sn = Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value
With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)  'put each row into a dictionary item using second column data which has the dups
        .Item(sn(j, 2)) = Application.Index(sn, j, 0)
    Next
    'Write edited (dup free in col A) list back to cols A:E
    Range("A2:E" & Cells(Rows.Count, "A").End(xlUp).Row).Clear
    Range("A2").Cells(1, 1).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
    Range("A1").CurrentRegion.Sort key1:=[A2], order1:=xlAscending, Header:=xlYes
End With
End Sub

Thanks Joe. This works.

 

[JoeMo]

Thanks Joe. This works.

You are welcome - thanks for the reply.