Get maximum value for unique record in three column

Hi PN,

Try this:

Sub pnnaik(): Dim Key As String, R As Range, M As Long, F As Range
Dim i As Long, j As Long, k As Long, CEF As String: i = 2: k = 2
[H1] = "": Key = [B2] & "~" & [E2] & "~" & [F2]: CEF = Key: j = i
Doit: Do Until CEF <> Key: j = j + 1:
CEF = Cells(j, 2) & "~" & Cells(j, 5) & "~" & Cells(j, 6)
Loop
Set R = Range("C" & i & ":C" & j - 1)
M = WorksheetFunction.MAX(R): Set F = R.Find(M)
Range("I" & k).Resize(1, 6).value = Range("A" & F.row).Resize(1, 6).value
Range("I" & k).Resize(1, 6).BorderAround Weight:=xlThin
    Key = Cells(j, 2) & "~" & Cells(j, 5) & "~" & Cells(j, 6)
                    If Cells(j, 2) <> "" Then
                i = j: k = k + 1: GoTo Doit: End If
                        i = 2: j = i: Key = [J2]
Groupit:            Do Until Cells(j, 10) <> Key: j = j + 1: Loop
                    Set R = Range("H" & i & ":H" & j - 1): R.Merge
                    R.Resize(j - i, 7).BorderAround Weight:=xlMedium
                    R = "Record for " & Key: Key = Cells(j, 10): i = j
                    If Cells(j, 10) = "" Then GoTo ExitSub
                    GoTo Groupit
ExitSub:  Set R = Union(Range("J2:J" & j), Range("M2:M" & j), Range("N2:N" & j))
            R.Interior.COLOR = [B2].Interior.COLOR
End Sub

Hi PN,

Thanks for the rep!

Sub pnnaik(): Dim Key As String, R As Range, M As Long, F As Range
Dim i As Long, j As Long, k As Long, CEF As String: i = 2: k = 2
            'Clear H1, Join B,E,F for use as key
[H1] = "": Key = [B2] & "~" & [E2] & "~" & [F2]: CEF = Key: j = i
            'Determine where key changes
Doit: Do Until CEF <> Key: j = j + 1:
            'Use CEF as interim key for comparison
CEF = Cells(j, 2) & "~" & Cells(j, 5) & "~" & Cells(j, 6)
Loop
        'Define the range to inspect for a maximum value
Set R = Range("C" & i & ":C" & j - 1)
        'Find the maximum value and the range it occupies
        M = WorksheetFunction.MAX(R): Set F = R.Find(M)
    'Write those values to the kth row (starting with 2) from the Ith column
Range("I" & k).Resize(1, 6).value = Range("A" & F.row).Resize(1, 6).value
    'Put a thin border around that output range
Range("I" & k).Resize(1, 6).BorderAround Weight:=xlThin
        'Reinitialize Key for next comparison
    Key = Cells(j, 2) & "~" & Cells(j, 5) & "~" & Cells(j, 6)
            'If data continues then
                    If Cells(j, 2) <> "" Then
                'reset indices and increment output row index k
                        'and repeat procedure
                i = j: k = k + 1: GoTo Doit: End If
                'Reset indices to start again from the top
                        'Key on just the ID
                        i = 2: j = i: Key = [J2]
                        'Determine where Key (ID) changes
Groupit:            Do Until Cells(j, 10) <> Key: j = j + 1: Loop
                        'Define the range to outline
                    Set R = Range("I" & i & ":I" & j - 1)
                        'Outline the range for that ID
                    R.Resize(j - i, 6).BorderAround Weight:=xlMedium
                        'Reset Key and row index for next grouping
                         Key = Cells(j, 10): i = j
                         'If data at end jump to ending procedure
                    If Cells(j, 10) = "" Then GoTo ExitSub
                    'Else repeat
                    GoTo Groupit
                    'Add colors to the three columns and finish
ExitSub:  Set R = Union(Range("J2:J" & j), Range("M2:M" & j), Range("N2:N" & j))
            R.Interior.COLOR = [B2].Interior.COLOR
End Sub

You're welcome!