How do you delete duplicate values assigned to a specific name in VBA/Excel?

For example I have the Table below

I'm trying to remove duplicate products associated with a certain name, so I would need to remove the extra Tom and Ice Cream row, but ensure that the Jack and Ice Cream row is kept.

I also have the following code I used in VBA to try to loop the filter in order to remove the duplicates, but it doesn't seem to work as I can't only select the sorted range when using Remove Duplicates

Sub Delete_Duplicates()

Dim Cell As Range

Worksheetname.Range("A1:B1").Select
Selection.AutoFilter
For Each Cell In Worksheetname("E1").End(xlDown)
    ActiveSheet.Range("$A$1:$B$8570").AutoFilter Field:=1, Criteria1:=Cell
    ActiveSheet.Range("$A$1", Range("B2").End(xlDown)).RemoveDuplicates Columns:=2, Header:=xlYes
Next Cell

End Sub

Any other methods using VBA or just Excel are much welcomed

You can fix your code like this:

Sub Delete_Duplicates()
ActiveSheet.Range("$A$1", Range("B2").End(xlDown)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
End Sub

As suggested by @SiddharthRout, the right way would be:

Sub Delete_Duplicates()
Dim LR As Long
'we get position of last non empty cell in column B
LR = Range("B" & Rows.Count).End(xlUp).Row

'remove duplicates
ActiveSheet.Range("$A$1:$B$" & LR).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
End Sub

Try using second one, it's indeed better, because Range("B2").End(xlDown)) does not always return the last non empty cell in column B.