Excel VBA Find String with largest value in adjacent cell

Question

I have a column with some text and another with numbers as below:

--------  -----
| GREY |  | 4 |
--------  -----
| BLUE |  | 3 |
--------  -----
| BLUE |  | 5 |
--------  -----
| GREY |  | 1 |
--------  -----

I'd like to find all the cells containing a certain string (let's say "Blue", see above), then the one with the highest value in the adjacent cell (which would give "5" here).

I know the FIND method and also how to get the largest value of a range (Application.WorksheetFunction.Max) but I have no idea how to combine both.

Could anybody help me please? Thank you in advance and sorry for my english!

Answer 1

You can use the MaxIfs for newer versions like so:

Function MaxIf(maxRange As Range, conditionRange As Range, conditionString As String) As Double

    If Application.Version >= 16 Then
        MaxIf = Application.WorksheetFunction.MaxIfs(maxRange, conditionRange, conditionString)
    Else
        Dim FormulaString As String
        FormulaString = "MAX(IF(" & conditionRange.Address & "=""" & conditionString & """, " & maxRange.Address & ", -9e99))"
        MaxIf = CDbl(conditionRange.Parent.Evaluate(FormulaString))
    End If
End Function

'''''

Sub test()
    MsgBox MaxIf(Sheet1.Range("B:B"), Sheet1.Range("A:A"), "blue")
End Sub

Answer 2

Newer Excel versions have a MAXIFS function. If you receive a #NAME? error when attempting this worksheet function, try one of these alternatives.

=aggregate(14, 7, b2:b5/(a2:a5="blue"), 1)
=max(index(b2:b5-(a2:a5<>"blue")*1e99, , ))

Use VBA to set a range object var to the cell contining the maximum number.

Sub main()

    Debug.Print maxnumfromcolor(Range("b2:b5"), Range("a2:a5"), "blue")

    Dim rng As Range

    Set rng = maxrngfromcolor(Range("b2:b5"), Range("a2:a5"), "blue")
    Debug.Print rng.Address

End Sub

Function maxnumfromcolor(rng1 As Range, rng2 As Range, str As String) As Double

    Dim i As Long

    Set rng1 = Intersect(rng1, rng1.Parent.UsedRange)
    Set rng2 = rng2.Resize(rng1.Rows.Count, rng1.Columns.Count)

    maxnumfromcolor = 0

    For i = 1 To rng1.Cells.Count

        If LCase(rng2.Cells(i).Value2) = LCase(str) Then
            maxnumfromcolor = _
                Application.Max(rng1.Cells(i).Value2, maxnumfromcolor)
        End If

    Next i

End Function

Function maxrngfromcolor(rng1 As Range, rng2 As Range, str As String) As Range

    Dim i As Long, mx As Double

    Set rng1 = Intersect(rng1, rng1.Parent.UsedRange)
    Set rng2 = rng2.Resize(rng1.Rows.Count, rng1.Columns.Count)

    mx = 0

    For i = 1 To rng1.Cells.Count

        If LCase(rng2.Cells(i).Value2) = LCase(str) Then
            If mx < rng1.Cells(i).Value2 Then
                Set maxrngfromcolor = rng1.Cells(i)  'use rng2 for 'blue cell
                mx = rng1.Cells(i).Value2
            End If
        End If

    Next i

End Function