CODEWITHSUNDEEP
vbaexcel
Saby
Saby

Reputation: 718

Find the maximum value

roll marks
10  900
10  700
10  800
20  400
20  400
30  1700
40  1800
10  800

Suppose I have to find the maximum value for duplicate roll, like for 10 output will be 900 (max of 900, 700, 800, 800).

I am able to find the duplicate but not able to find the max.

Sub sbFindDuplicatesInColumn()
    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    lastRow = Range("H65000").End(xlUp).Row

    For iCntr = 5 To lastRow
    Dim intArr(1000) As Integer
    Dim iCounter
    iCounter = 0
    If Cells(iCntr, 8) <> "" Then
        matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 8), Range("H1:H" & lastRow), 0)
        If iCntr <> matchFoundIndex Then

            Cells(iCntr, 10) = "Duplicate"
       End If
    End If
    Next
End Sub

Upvotes: 0

Views: 188

Answers (3)

Tragamor
Tragamor

Reputation: 3634

You could use an autofilter to find the duplicates, then the subtotal function to find the maximum value...

Sub FindMaxWithinDuplicates()

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim LastRow As Long: LastRow = ws.Range("H65000").End(xlUp).Row
    Dim Tbl As Range: Set Tbl = ws.Range(Cells(5, 8), Cells(LastRow, 9))
    Dim TblCriteria As Long: TblCriteria = 10

    Dim MaxValue As Long

    With ws
        Tbl.AutoFilter Field:=1, Criteria1:=TblCriteria
        MaxValue = Application.WorksheetFunction.Subtotal(104, Tbl.Columns(2))
        Tbl.AutoFilter
    End With

    MsgBox MaxValue

End Sub

Upvotes: 0

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

With data in cols A and B use:

Sub dural()
   MsgBox Evaluate("MAX(IF(A2:A9=10,B2:B9))")
End Sub

enter image description here

This is because VBA will assume the array formula.

Upvotes: 3

Raystafarian
Raystafarian

Reputation: 3022

I'd try it this way, using a dictionary as an index and looping through. It's not as quick as an array, so depending on your data size, it might be slow. You can do anything instead of the msgbox -

Sub test()
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim lastrow As Long
lastrow = Range("H65000").End(xlUp).Row
Dim icntr As Long

For icntr = 5 To lastrow
Dim val As Long
val = Cells(icntr, 8)
dict(val) = 1
Next

Dim maxval As Long
For Each Key In dict.keys
    maxval = 1
    For icntr = 5 To lastrow

        If Cells(icntr, 8) = Key Then
            If Cells(icntr, 9) > maxval Then
                maxval = Cells(icntr, 9)
            End If
        End If
    Next
    MsgBox ("maximum for " & Key & " is " & maxval)

Next

End Sub

Upvotes: 2

Related Questions