NEED HELP with Macros!!

nads321

New Member
Joined
Apr 4, 2013
Messages
2
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.
 

Some videos you may like

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
L

Legacy 234512

Guest
This will do the job

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,073
Messages
5,599,619
Members
414,325
Latest member
annamsreenu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top