doovers
doovers

Reputation: 8675

VBA - Get index of nth largest value in an array

I want to find the index of the nth largest value in an array. I can do the following but it runs into trouble when 2 values are equal.

fltArr(0)=31
fltArr(1)=15
fltArr(2)=31
fltArr(3)=52

For i = 0 To UBound(fltArr)
    If fltArr(i) = Application.WorksheetFunction.Large(fltArr, n) Then
        result = i
    End If
Next

n=1 ---> 3
n=2 ---> 2 (but I want this to be 0)
n=3 ---> 2
n=4 ---> 1

Upvotes: 6

Views: 17189

Answers (5)

Ans
Ans

Reputation: 1234

Here's code for finding the nth largest item in collection. All you need to do is to write a function that would return it's index.

Sub testColl()
    Dim tempColl As Collection
    Set tempColl = New Collection
    tempColl.Add 57
    tempColl.Add 10
    tempColl.Add 15
    tempColl.Add 100
    tempColl.Add 8


    Debug.Print largestNumber(tempColl, 2)  'prints 57
End Sub

and the function itself, the easiest I could come up with.

Function largestNumber(inputColl As Collection, indexMax As Long)
        Dim element As Variant
        Dim result As Double
        result = 0

        Dim i As Long
        Dim previousMax As Double

        For i = 1 To indexMax
            For Each element In inputColl
                If i > 1 And element > result And element < previousMax Then
                    result = element
                ElseIf i = 1 And element > result Then
                    result = element
                End If
            Next

            previousMax = result
            result = 0
        Next

        largestNumber = previousMax
End Function

Upvotes: 0

brettdj
brettdj

Reputation: 55682

Uses a second array to quickly get what you want without looping through each element for every value of n

Sub test()

Dim fltArr(0 To 3)
Dim X
Dim n As Long
Dim lngPos As Long

fltArr(0) = 31
fltArr(1) = 15
fltArr(2) = 31
fltArr(3) = 52

X = fltArr

For n = 1 To 4
    lngPos = Application.WorksheetFunction.Match(Application.Large(X, n), X, 0) - 1
    Debug.Print lngPos
    X(lngPos) = Application.Max(X)
Next

End Sub

Upvotes: 6

El Scripto
El Scripto

Reputation: 576

Edit:

Public Sub RunLarge()
Dim n%, i%, result%, count%
Dim fltArr(3) As Integer
Dim iLarge As Integer

fltArr(0) = 31:
fltArr(1) = 15:
fltArr(2) = 31:
fltArr(3) = 52
n = 1

Debug.Print " n", "iLarge", "result"

While n <= 4
    count% = n - 1
    iLarge = Application.WorksheetFunction.Large(fltArr, n)

    For i = 0 To UBound(fltArr)
        If fltArr(i) = iLarge Then
            result = i
            count% = count% - 1
            If count% <= 0 Then Exit For
        End If
    Next

    Debug.Print n, iLarge, result
    n = n + 1
Wend
End Sub

result:

 n            iLarge        result
 1             52            3 
 2             31            0 
 3             31            2 
 4             15            1 

Upvotes: 2

Dan Donoghue
Dan Donoghue

Reputation: 6206

Perhaps this:

Public Sub RunLarge()
Dim fltArr() As Variant, X As Long
fltArr = Array(31, 15, 31, 52) 'Create the array
For X = 1 To 4 'Loop the number of large values you want to index
    For i = LBound(fltArr) To UBound(fltArr) 'Loop the array
        If fltArr(i) = Application.WorksheetFunction.Large(fltArr, 1) Then 'Find first instance of largest value
            result = i
            fltArr(i) = -9999 'Change the value in the array to -9999
            Exit For
        End If
    Next
    Debug.Print result
Next
End Sub

As it finds the first instance of the large number it replaces it with -9999 so on the next sweep it will pick the next instance of it.

Upvotes: 0

Simon
Simon

Reputation: 577

It's a bit "dirty" but seeing as you're in Excel...

' Create a sheet with codename wsTemp...

For i = 0 To UBound(fltArr)
    wsTemp.cells(i,1) = i
    wsTemp.cells(i,2) = fltArr(i)
Next

with wsTemp
    .range(.cells(1,1),.cells(i,2)).sort(wsTemp.cells(1,2),xlDescending)
end with

Result = wsTemp.cells(n,1)

Then you could also expand the sort to "sort by value then by index" if you wanted to control the "which of two equal 2nds should i choose" thing...

Upvotes: 0

Related Questions