Home » excel » Get Cell reference for TOP 3 numbers within a Range (Excel VBA)

Get Cell reference for TOP 3 numbers within a Range (Excel VBA)

Posted by: admin May 14, 2020 Leave a comment


I have a Range of Cells in Excel with numbers (Let’s say A1:Z1) and I want to get three highest numbers. Answer to this part of the question I found here – Finding highest and subsequent values in a range

But I want also to get the cell reference of these values.

firstVal = Application.WorksheetFunction.Large(rng,1)
secondVal = Application.WorksheetFunction.Large(rng,2)        
thirdVal = Application.WorksheetFunction.Large(rng,3)
How to&Answers:

After getting the values, try looping through the range and assign range variables to these. Then print the addresses of the range variables:

Sub TestMe()

    Dim firstVal As Double
    Dim secondVal As Double
    Dim thirdVal As Double
    Dim rng As Range
    Set rng = Worksheets(1).Range("A1:B10")

    With Application
        firstVal = Application.WorksheetFunction.Large(rng, 1)
        secondVal = Application.WorksheetFunction.Large(rng, 2)
        thirdVal = Application.WorksheetFunction.Large(rng, 3)
    End With

    Dim myCell As Range
    Dim firstCell As Range
    Dim secondCell As Range
    Dim thirdCell As Range

    For Each myCell In rng
        If myCell.Value = firstVal And (firstCell Is Nothing) Then
            Set firstCell = myCell
        ElseIf myCell.Value = secondVal And (secondCell Is Nothing) Then
            Set secondCell = myCell
        ElseIf myCell.Value = thirdVal And (thirdCell Is Nothing) Then
            Set thirdCell = myCell
        End If
    Next myCell

    Debug.Print firstCell.Address, secondCell.Address, thirdCell.Address

End Sub

The check firstCell Is Nothing is done to make sure that in case of more than one top variable, the second one is assigned to the secondCell. E.g., if the range looks like this:

enter image description here

then the top 3 cells would be A2, A3, A1.


Not very efficient but you can specify how many addresses to return:

Sub Tester()

    Debug.Print Join(Largest(ActiveSheet.Range("A1:Z1"), 3), ", ")

End Sub

Function Largest(rng As Range, howMany As Long)
    Dim rv(), n As Long, c As Range, lg
    ReDim rv(1 To howMany)
    n = 1
        lg = Application.Large(rng, n)
        For Each c In rng
            If c.Value = lg Then
                If IsError(Application.Match(c.Address, rv, 0)) Then
                    rv(n) = c.Address
                    n = n + 1
                    Exit For
                End If
            End If
        Next c
    Loop While n <= howMany
    Largest = rv
End Function