How to select the highest Number in a column in accordance to Highest number in another column

Question

| Part Name | Issue Number | Sequence Number
    A1          1              1
    A1          1              2
   **A1         2              1**
   **A2         1              1**
    A3          1              1
    A3          1              2
    A3          1              3
    A3          2              1
    A3          3              1
    A3          4              1
    A3          4                  2
   **A3          4                  3**
    A4          1              1
    A4          1              2
   **A4         1              3**
    B1          1              1
    B1          2              1
    B1          2              2
    B1          3              1
    B1          3              2
    B1          3              3
    B1          3              4
    B1          3              5
    B1          3              6
    B1          4              1
   **B1         5              1**

So I have three columns , the first one is Part Number , Second is Issue Number and the third is Sequence number. I want to select the highest issue number for every part name and then the highest sequence number for that issue number and get all of them in a sperate excel sheet.

I used chatgpt and got this code. It doesn't work. If you know the solution please help.

Sub AlignDataAndCreateTabs()
    Dim ws As Worksheet, newWs As Worksheet
    Dim lastRow As Long, uniqueItem As Object
    Dim rng As Range, cell As Range
    Dim item As Variant, maxVal2 As Double, maxVal3 As Double
    Dim dict As Object, sheetName As String
    
    ' Set reference to active sheet
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Get last row in column A
    
    Set uniqueItem = CreateObject("Scripting.Dictionary") ' Store unique items from Column A
    Set dict = CreateObject("Scripting.Dictionary") ' Store max values for each unique item
    
    ' Loop through Column A to get unique items
    For Each cell In ws.Range("A2:A" & lastRow)
        item = cell.Value
        If Not uniqueItem.Exists(item) Then
            uniqueItem.Add item, Nothing
        End If
    Next cell
    
    ' Process each unique item
    For Each item In uniqueItem.Keys
        maxVal2 = -1: maxVal3 = -1 ' Initialize max values
        
        ' Loop through the sheet to find max in Column B for each unique Column A item
        For Each cell In ws.Range("A2:A" & lastRow)
            If cell.Value = item Then
                If IsNumeric(cell.Offset(0, 1).Value) And cell.Offset(0, 1).Value > maxVal2 Then
                    maxVal2 = cell.Offset(0, 1).Value
                End If
            End If
        Next cell
        
        ' Find max in Column C corresponding to maxVal2
        For Each cell In ws.Range("A2:A" & lastRow)
            If cell.Value = item And cell.Offset(0, 1).Value = maxVal2 Then
                If IsNumeric(cell.Offset(0, 2).Value) And cell.Offset(0, 2).Value > maxVal3 Then
                    maxVal3 = cell.Offset(0, 2).Value
                End If
            End If
        Next cell
        
        ' Store results
        dict.Add item, Array(maxVal2, maxVal3)
    Next item
    
    ' Create new sheets and add selected values
    Application.ScreenUpdating = False
    For Each item In dict.Keys
        ' Sanitize sheet name
        sheetName = Left(WorksheetFunction.Clean(CStr(item)), 31)
        sheetName = Replace(sheetName, "\", "_")
        sheetName = Replace(sheetName, "/", "_")
        sheetName = Replace(sheetName, "?", "_")
        sheetName = Replace(sheetName, "*", "_")
        sheetName = Replace(sheetName, "[", "_")
        sheetName = Replace(sheetName, "]", "_")
        
        On Error Resume Next
        Set newWs = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0
        If newWs Is Nothing Then
            Set newWs = ThisWorkbook.Sheets.Add
            newWs.Name = sheetName
        End If
        
        ' Write headers
        newWs.Cells(1, 1).Value = "Item"
        newWs.Cells(1, 2).Value = "Max Column B"
        newWs.Cells(1, 3).Value = "Max Column C"
        
        ' Write values
        Dim rowIndex As Integer
        rowIndex = 2
        For Each cell In ws.Range("A2:A" & lastRow)
            If cell.Value = item Then
                newWs.Cells(rowIndex, 1).Value = item
                newWs.Cells(rowIndex, 2).Value = dict(item)(0)
                newWs.Cells(rowIndex, 3).Value = dict(item)(1)
                rowIndex = rowIndex + 1
            End If
        Next cell
        
        Set newWs = Nothing
    Next item
    Application.ScreenUpdating = True
    
  
End Sub

Answer 1

As per comment, you can achieve this by the following formula-

=DROP(REDUCE("",UNIQUE(A1:A26),LAMBDA(acc,data,VSTACK(acc,TAKE(SORT(FILTER(A1:C26,A1:A26=data),{2,3},{-1,-1}),1)))),1)

If TRIMRANGE() is available then could refer full columns.

=DROP(REDUCE("",UNIQUE(A.:.A),LAMBDA(acc,data,VSTACK(acc,TAKE(SORT(FILTER(A.:.C,A.:.A=data),{2,3},{-1,-1}),1)))),1)

And with header-

=REDUCE({"Part No","Issue No","Sequence No"},UNIQUE(A1:A26),LAMBDA(a,x,VSTACK(a,TAKE(SORT(FILTER(A1:C26,A1:A26=x),{2,3},{-1,-1}),1))))

Input Data:

A1	1	1
A1	1	2
A1	2	1
A2	1	1
A3	1	1
A3	1	2
A3	1	3
A3	2	1
A3	3	1
A3	4	1
A3	4	2
A3	4	3
A4	1	1
A4	1	2
A4	1	3
B1	1	1
B1	2	1
B1	2	2
B1	3	1
B1	3	2
B1	3	3
B1	3	4
B1	3	5
B1	3	6
B1	4	1
B1	5	1

Output result:

A1	2	1
A2	1	1
A3	4	3
A4	1	3
B1	5	1