NEED HELP with Macros!!

[nads321]

I have a project which is due tomorrow, end of day, so I'm panicing at this point. Any help would be greatly appreciated.

I need the macro to find duplicate entries in 2 separate columns (last name, first name) and delete the entry with those with a lower value in a third column.

For example,
Column A = Last Name
Column B = First Name
Column R = Final test result

So basically people who have taken a test more than once, only their highest mark will count, which is why I need to delete the lower test value.

If it matters, some people have also taken the test three times.

 

[Legacy 234512]

This will do the job

Option Explicit


Public Const deli = "..."


Sub main()
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)
    Dim lastRow As Long
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    Dim iarr As Variant
    
    extr arr:=iarr, ws:=ws, lastRow:=lastRow
    remov arr:=iarr, ws:=ws, i:=lastRow
    
End Sub


Sub extr(ByRef arr As Variant, ByRef ws As Worksheet, ByVal lastRow)
    
    Dim i, j
    ReDim arr(lastRow - 1)
    For i = 2 To lastRow
        arr(i - 2) = ws.Range("A" & i).Value & deli & ws.Range("B" & i).Value
    Next i
    
    ReDim Preserve arr(UBound(arr))
    For i = LBound(arr) To UBound(arr)
        For j = LBound(arr) To UBound(arr)
            If arr(i) = arr(j) Then
                If ws.Range("R" & i + 2).Value > ws.Range("R" & j + 2).Value Then
                    arr(i) = j + 2
                ElseIf ws.Range("R" & i + 2).Value < ws.Range("R" & j + 2).Value Then
                    arr(i) = i + 2
                End If
            End If
        Next j
    Next i
End Sub


Sub remov(ByRef arr As Variant, ByRef ws As Worksheet, ByVal i As Long)
    For i = UBound(arr) To LBound(arr) Step -1
        If IsNumeric(arr(i)) And arr(i) <> 0 Then
            ws.Rows(arr(i) & ":" & arr(i)).Select
            Selection.Delete shift:=xlUp
        End If
    Next i
End Sub

 

[nads321]

Thank you so much! Such a great help!