How to determine the MAX value of a sub-group in a VBA Array

Get Maximum of Each Unique Value

• The dictionary will hold the unique value as its key, and the row of the highest value as the corresponding item. While looping, it will use this item to compare the values of the 2nd column and modify it accordingly. In the end, another loop will write the results to the same array which will partially be copied to the destination range.
• One row of headers is assumed. If you don't want the headers, then change the sfcAddress if necessary and change For r = 1 to srCount and r = 0.

Option Explicit

Sub MaxOfUnique()
    
    Const sName As String = "Sheet1"
    Const sfcAddress As String = "A1"
    
    Const dName As String = "Sheet1"
    Const dfcAddress As String = "E1"
    
    Const cCount As Long = 3
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim sfCell As Range: Set sfCell = sws.Range(sfcAddress)
    Dim srg As Range
    With sfCell.CurrentRegion
        Set srg = sfCell.Resize(.Row + .Rows.Count _
            - sfCell.Row, .Column + .Columns.Count - sfCell.Column)
    End With
    Dim srCount As Long: srCount = srg.Rows.Count
    If srCount < 2 Then Exit Sub
    
    Dim Data As Variant: Data = srg.Value
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim r As Long
    
    For r = 2 To srCount
        If dict.Exists(Data(r, 1)) Then
            If Data(r, 2) > Data(dict(Data(r, 1)), 2) Then
                dict(Data(r, 1)) = r
            End If
        Else
            dict(Data(r, 1)) = r
        End If
    Next r
    
    Dim Key As Variant
    
    r = 1
    For Each Key In dict.Keys
        r = r + 1
        Data(r, 1) = Key
        Data(r, 2) = Data(dict(Key), 2)
        Data(r, 3) = Data(dict(Key), 3)
    Next Key
    
    With wb.Worksheets(dName).Range(dfcAddress).Resize(, cCount)
        .Resize(r).Value = Data ' write
        .Resize(.Worksheet.Rows.Count - .Row - r + 1).Offset(r).Clear ' below
    End With
    
End Sub

You can use a dictionary to keep track of the maximum values, see example below.

This is the class module called "Record"

Public id As Integer
Public value As Integer
Public data As Integer

Here's the code for the button click I wired up on the sheet

Sub Button3_Click()
    Dim dict                   'Create a variable
    Set dict = CreateObject("Scripting.Dictionary")
    
    Dim dataArr() As Variant
    Dim id, value, data As Integer
    dataArr = Range("A2:C7").value
    Dim rec As Record
    
    For i = 1 To UBound(dataArr)
        id = dataArr(i, 1)
        value = dataArr(i, 2)
        data = dataArr(i, 3)
        
        If (dict.Exists(id)) Then
            Set rec = dict(id)
            ' if value is greater, then update it in dictionary for this id
            If (value > rec.value) Then
                dict.Remove (rec.id)
                Set rec = New Record
                rec.id = id
                rec.value = value
                rec.data = data
                dict.Add id, rec
            End If
        Else
            ' this is an id we haven't seen before, so add rec to dictionary
            Set rec = New Record
            rec.id = id
            rec.value = value
            rec.data = data
            dict.Add id, rec
        End If
    Next
    
    ' print results
    Dim result As String
    For Each id In dict.Keys()
        Set rec = dict(id)
        result = result & "id = " & id & ", maxValue = " & rec.value & ", data = " & rec.data & vbCrLf
    Next
    
    MsgBox (result)
    
End Sub