VBA REMOVE DUPLICATES AND KEEP LAST ONE

[duplaly]

HI
I need help to solve my problem of duplicates based on Columns A & B and delete EntireRow keepping the last entry
The vba code should compare A & B and delete the entire row duplicates.
Many Thanks!

A	B
1 juin 2020	Rouge Montréal
1 juin 2020	International
1 juin 2020	Rouge / GEC Qc
1 juin 2020	Ottawa Fluo "J"
1 juin 2020	Fluo "J"
1 juin 2020	Abitibi Fluo "J"
1 juin 2020	Fluo "G" - G-555
1 juin 2020	Fluo "G"- G-551
1 juin 2020	Domestique
1 juin 2020	GEC Montréal
3 juin 2020	Rouge Montréal
3 juin 2020	International
3 juin 2020	Rouge / GEC Qc
3 juin 2020	Ottawa Fluo "J"
3 juin 2020	Fluo "J"
3 juin 2020	Abitibi Fluo "J"
3 juin 2020	Fluo "G" - G-555
3 juin 2020	Fluo "G"- G-551
3 juin 2020	Domestique
3 juin 2020	GEC Montréal
9 juin 2020	Rouge Montréal
9 juin 2020	International
9 juin 2020	Rouge / GEC Qc
9 juin 2020	Ottawa Fluo "J"
9 juin 2020	Fluo "J"
9 juin 2020	Abitibi Fluo "J"
9 juin 2020	Fluo "G" - G-555
9 juin 2020	Fluo "G"- G-551
9 juin 2020	Domestique
9 juin 2020	GEC Montréal
10 juin 2020	Rouge Montréal
10 juin 2020	International
10 juin 2020	Rouge / GEC Qc
10 juin 2020	Ottawa Fluo "J"
10 juin 2020	Fluo "J"
10 juin 2020	Abitibi Fluo "J"
10 juin 2020	Fluo "G" - G-555
10 juin 2020	Fluo "G"- G-551
10 juin 2020	Domestique
10 juin 2020	GEC Montréal
1 juin 2020	Rouge Montréal
1 juin 2020	International
1 juin 2020	Rouge / GEC Qc
1 juin 2020	Ottawa Fluo "J"
1 juin 2020	Fluo "J"
1 juin 2020	Abitibi Fluo "J"
1 juin 2020	Fluo "G" - G-555
1 juin 2020	Fluo "G"- G-551
1 juin 2020	Domestique
1 juin 2020	GEC Montréal
10 juin 2020	Rouge Montréal
10 juin 2020	International
10 juin 2020	Rouge / GEC Qc
10 juin 2020	Ottawa Fluo "J"
10 juin 2020	Fluo "J"
10 juin 2020	Abitibi Fluo "J"
10 juin 2020	Fluo "G" - G-555
10 juin 2020	Fluo "G"- G-551
10 juin 2020	Domestique
10 juin 2020	GEC Montréal

 

[DanteAmor]

Try this

Sub Delete_Rows()
  Dim a As Variant, dic As Object, r As Range
  Dim lr As Long, i As Long
  
  lr = Range("A" & Rows.Count).End(3).Row
  a = Range("A1:B" & lr)
  Set r = Range("A" & lr + 1)
  Set dic = CreateObject("Scripting.Dictionary")
  
  For i = UBound(a, 1) To 1 Step -1
    If dic.exists(a(i, 1) & "|" & a(i, 2)) Then
      Set r = Union(r, Range("A" & i))
    End If
    dic(a(i, 1) & "|" & a(i, 2)) = Empty
  Next
  
  r.EntireRow.Delete
End Sub

 

[duplaly]

Sir
A great thanks for the help!
amazing!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.