Snasui Excel Forum

Code: Select all

Sub Findmax1()

'Sort Data

    Range("A1:B15").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A15") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B15") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B15")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'Start fine max

Dim i As Long
Dim LabX As Long
Dim MaxT As Long

lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastrow

   If Cells(i, 2).Value > Cells(i + 1, 2).Value Then

       Cells(i, 3).Value = Cells(i, 2).Value
   End If
   
Next i

End Sub

Code: Select all

Dim i As Long
Dim lastRow As Long
Dim countRow As Long
Dim orderRow As Long

lastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastRow
    orderRow = Application.Match(Cells(i, 1), Range(Cells(2, 1), Cells(lastRow, 1)), 0) + 1
    countRow = Application.CountIf(Range(Cells(2, 1), Cells(lastRow, 1)), Cells(i, 1))
   If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
        Cells(i, 3).Value = Application.Max(Cells(orderRow, 2).Resize(countRow))
   End If
Next i