Macro almost works. Does not Delete as desired

I have a macro that deletes duplicate versions of a work number. The macro runs the way I need it to but when it goes to delete the information it doesnt delete the data in columns A & B.

The file I'm working with
Test Run pt 4.xlsm

Sub keep_highest()

Dim k As Object, c, al As Long
Set k = CreateObject("Scripting.dictionary")
c = Sheets("sheet1").Cells(1).CurrentRegion
For al = 2 To UBound(c)
    If c(al, 8) > k(c(al, 3)) Then k(c(al, 3)) = c(al, 8)
Next al
For al = UBound(c) To 2 Step -1
    If c(al, 8) <> k(c(al, 3)) Then Cells(al, 3).Resize(, UBound(c, 2)).Delete xlUp
Next al

End Sub