Deleting duplicates and replacing entries in a row – Excel VBA - excel

Question

In this project, I am looking to delete duplicates based on the ID number by keeping the latest entries. Additionally, I want to keep every cell in Column D and onward from the previous entries. This ultimately means that the latest entries will be replaced in the previous entries’ row. Please see tables below for more clarity:
Based on the example given above, the result I am looking for is to:
Delete duplicates based on the ID from columns A to C and keep the latest entries
Keep Columns D to H from the previous entries
Replace previous entries by the latest ones in the previous entries’ row.
In other words: Update Columns A to C without modifying Columns D to H
So, the initial code that I had was as follow. It only kept the previous entries and kept columns D to H:
Sub Delete_Duplicates()
Sheet5.Range("$A$1:$H$29999").RemoveDuplicates Columns:=Array(1) _
, Header:=xlYes
End Sub
The table below shows what i would obtain:
The next code I did was to keep the newest entries, but this deletes my entries in column D to H:
Sub Delete_Duplicates_2()
Dim Rng As Range, Dn As Range, n As Long
Dim Lst As Long, nRng As Range
Set Rng = Sheet5.Range("$A$2:$H$29999")
Lst = Range("A" & Rows.Count).End(xlUp).Row
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For n = Lst To 1 Step -1
If Not .Exists(Range("A" & n).Value) Then
.Add Range("A" & n).Value, Nothing
Else
If nRng Is Nothing Then
Set nRng = Range("A" & n)
Else
Set nRng = Union(nRng, Range("A" & n))
End If
End If
Next n
If Not nRng Is Nothing Then
nRng.EntireRow.Delete
End With
End Sub
The table below shows what I would obtain:
I am open to any suggestions and thank you for your help!

Answer 1

Try this solution - since you're essentially working with a string in your date column, we have to split out the number and test to see if it's greater or less than the other week's number:
Option Explicit
Sub Delete_Duplicates()
Dim i As Long, j As Long
Dim id As String, weeknum As Long
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
id = Cells(i, 1).Value
weeknum = Split(Cells(i, 3).Value, " ")(1)
For j = i - 1 To 2 Step -1
If Cells(j, 1).Value = id Then
If Split(Cells(j, 3).Value, " ")(1) < weeknum Then
Rows(j).Delete
i = i - 1
Else
Rows(i).Delete
Exit For
End If
End If
Next j
Next i
End Sub