Excel VBA Find String with largest value in adjacent cell

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

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