Find duplicate value in a column, and check from another one to delete the recent rows

I'm working on a excel vba table where I can find some duplicate value in columns 'I'.
I need to delete the last duplicate rows (This one who didn't had manual data added).
For doing that I created a column in "CF" with the date where the rows was created.
So I need to delete duplicate data in column 'I' where the date is the most recent.

Exemple :
Row 1 column 'I' : 9095-IDE
Row 1 column 'CF' : 21/06/23 14:50:16

Row 2 column 'I' : 9095-IDE
Row 2 column 'CF' : 26/06/23 14:45:42

Then Row 2 would be delete.
That work, but sometime I don't know why, it will be row 1 who will be delete.
That shit cause in a lot column between I & CF, user need to write manual data in.. So if I delete the wrong one, they lost their data...

Here my VBA macro :

Sub supprimerDoublons()
    Dim derniereligne As Long
    Dim dict As Object
    Dim a As Long
    Dim x As Variant
    Dim rngToDelete As Range
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    derniereligne = ActiveSheet.Cells(Rows.Count, "I").End(xlUp).Row
    
    For a = 5 To derniereligne
        x = Cells(a, "I").Value
        If Not dict.exists(x) Then
            dict.Add x, a
        Else
            If Cells(a, "CF").Value > Cells(dict(x), "CF").Value Then
                If rngToDelete Is Nothing Then
                    Set rngToDelete = Rows(a)
                Else
                    Set rngToDelete = Union(rngToDelete, Rows(a))
                End If
            Else
                If rngToDelete Is Nothing Then
                    Set rngToDelete = Rows(dict(x))
                Else
                    Set rngToDelete = Union(rngToDelete, Rows(dict(x)))
                End If
                dict.Item(x) = a
            End If
        End If
    Next a
    
    If Not rngToDelete Is Nothing Then
        rngToDelete.Delete
    End If
    
End Sub

It will run on rows, stock a value in dictionnary. If a same value is already in dictionnary, it will check in CF the date and stock in rngToDelete the right one to delete.

In paper, it look amazing, but can't find why sometime it didn't work well, and delete the wrong row ...

Can someone help me ?

I tried many thing, but I can't replicate the bug everytime, it like random ..
Would like to know if anyone had similare trouble, or have another solutions ..

Delete 'Duplicate' Rows: Keep the First (Top-Most) Smallest Value in a Column

A Quick Fix

• Your If statement is wrong because it doesn't cover the case when the cells in column CF are equal which is falling under the Else statement in your code. To correct this, use:

  If Cells(a, "CF").Value >= Cells(dict(x), "CF").Value Then
  

An Improvement

• Use more variables and a function to combine the cells to vastly improve the code's readability.
• Qualify all ranges, cells, rows, and columns with the correct worksheet so the code would work if you would (correctly) specify the worksheet with e.g. Set ws = ThisWorkbook.Worksheets("Sheet1"), not relying on the active sheet.

<!-- language: lang-vb -->

Sub DeleteDuplicateRows()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' i.e. 'A = a'
    
    Dim rngToDelete As Range, NewValue, PreviousValue, sStr As String
    Dim r As Long, pr As Long
    
    For r = 5 To LastRow
        sStr = CStr(ws.Cells(r, "I").Value)
        If Not dict.Exists(sStr) Then
            dict(sStr) = r
        Else
            pr = dict(sStr)
            PreviousValue = ws.Cells(pr, "CF").Value
            NewValue = ws.Cells(r, "CF").Value
            If NewValue >= PreviousValue Then
                Set rngToDelete = RefCombinedRange(rngToDelete, ws.Rows(r))
            Else
                dict(sStr) = r
                Set rngToDelete = RefCombinedRange(rngToDelete, ws.Rows(pr))
            End If
        End If
    Next r
    
    If Not rngToDelete Is Nothing Then
        ' Test with:
        rngToDelete.Select
        ' When done testing, use the following instead.
        'rngToDelete.Delete xlShiftUp
    End If
    
End Sub

Function RefCombinedRange(ByVal urg As Range,ByVal arg As Range) As Range
    If urg Is Nothing Then Set urg = arg Else Set urg = Union(urg, arg)
    Set RefCombinedRange = urg
End Function

I do something like this :

Sub supprimerDoublons()
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    'Les filtres
    Dim filterRange As Range
    Dim filterCriteria As Variant

    If ws.AutoFilterMode Then
    ' Mémoriser la plage et les critères de filtre existants
    Set filterRange = ws.AutoFilter.Range
    filterCriteria = ws.AutoFilter.Filters
    
    ws.ShowAllData ' Effacer les filtres

    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' i.e. 'A = a'
    
    Dim rngToDelete As Range, NewValue, PreviousValue, sStr As String
    Dim r As Long, pr As Long
    
    For r = 5 To LastRow
        sStr = CStr(ws.Cells(r, "I").Value)
        If Not dict.Exists(sStr) Then
            dict(sStr) = r
        Else
            pr = dict(sStr)
            PreviousValue = ws.Cells(pr, "CF").Value
            NewValue = ws.Cells(r, "CF").Value
            If NewValue >= PreviousValue Then
                Set rngToDelete = RefCombinedRange(rngToDelete, ws.Rows(r))
            Else
                dict(sStr) = r
                Set rngToDelete = RefCombinedRange(rngToDelete, ws.Rows(pr))
            End If
        End If
    Next r
    
    If Not rngToDelete Is Nothing Then
        ' Test with:
        'rngToDelete.Select
        'When done testing, use the following instead.
        rngToDelete.Delete xlShiftUp
    End If
    
        ' Rétablir les filtres précédents
    filterRange.AutoFilter Field:=5, Criteria1:=filterCriteria(5)
    ' Répétez cette ligne pour chaque colonne avec des filtres, en ajustant l'index de la colonne et du critère si nécessaire
    filterRange.AutoFilter Field:=7, Criteria1:=filterCriteria(7)
    filterRange.AutoFilter Field:=8, Criteria1:=filterCriteria(8)
End If
    
End Sub

Function RefCombinedRange(ByVal urg As Range, ByVal arg As Range) As Range
    If urg Is Nothing Then Set urg = arg Else Set urg = Union(urg, arg)
    Set RefCombinedRange = urg
End Function

But I got an error 450 on execution, can't find why ..