Nth Largest Unique Value in an Array (UDF)

[Admin]

Hi All,

Here is an UDF to find the nth Largest unique value from an array.


Function NTHLARGESTUNIQUE(ByRef InpData, Optional ByVal Nth As Long = 1)

Dim i As Long, UB1 As Long, UB2 As Long

NTHLARGESTUNIQUE = CVErr(xlErrNum)
If TypeOf InpData Is Range Then
If InpData.Rows.Count > 1 And InpData.Columns.Count = 1 Then
InpData = Application.Transpose(InpData.Value2)
ElseIf InpData.Rows.Count = 1 And InpData.Columns.Count > 1 Then
InpData = Application.Transpose(Application.Transpose(InpDat a.Value2))
Else
Exit Function
End If
End If

On Error Resume Next
UB1 = UBound(InpData, 1)
UB2 = UBound(InpData, 2)
On Error GoTo 0

If UB1 > 0 And UB2 > 0 Then Exit Function

With CreateObject("system.collections.sortedlist")
For i = LBound(InpData) To UBound(InpData)
.Item(InpData(i)) = Empty
Next
If .Count Then
NTHLARGESTUNIQUE = .getkey(.Count - Nth)
End If
End With

End Function

Use like

=NTHLARGESTUNIQUE(A1:A15,2)

or

=NTHLARGESTUNIQUE(A1:G1,2)

or


MsgBox NTHLARGESTUNIQUE([{1,2,5,8,4}], 3)

BTW, for those who want to know about system.collections.sortedlist, find this MSDN link:


SortedList Class (http://msdn.microsoft.com/en-us/library/system.collections.sortedlist.aspx) https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Rick Rothstein]

Here is an UDF to find the nth Largest unique value from an array.

Function NTHLARGESTUNIQUE(ByRef InpData, Optional ByVal Nth As Long = 1)

Dim i As Long, UB1 As Long, UB2 As Long

NTHLARGESTUNIQUE = CVErr(xlErrNum)
If TypeOf InpData Is Range Then
If InpData.Rows.Count > 1 And InpData.Columns.Count = 1 Then
InpData = Application.Transpose(InpData.Value2)
ElseIf InpData.Rows.Count = 1 And InpData.Columns.Count > 1 Then
InpData = Application.Transpose(Application.Transpose(InpDat a.Value2))
Else
Exit Function
End If
End If
....
.... < snip >
....

Just wanted to point out that the double call to Application.Transpose (highlighted in bold) can be replaced with a single call to Application.Index (which should also be faster)...

InpData = Application.Index(InpData.Value2, 1, 0)


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Admin]

Thanks Rick :)

[Rick Rothstein]

Thanks Rick :)
You are welcome, of course. I looked at your function in a little more depth and am not sure why you restricted it to only (contiguous) numerical data in single column ranges or single row ranges. If I am not mistaken, I believe the following will work correctly for (contiguous) numerical data in single column ranges, single row ranges OR rectangular ranges...


Function NTHLARGESTUNIQUE(InpData As Variant, Optional ByVal Nth As Long = 1) As Variant
Dim V As Variant, Arry As Variant
NTHLARGESTUNIQUE = CVErr(xlErrNum)
On Error GoTo Whoops
Arry = InpData
With CreateObject("System.Collections.SortedList")
For Each V In Arry
.Item(V) = Empty
Next
If .Count Then NTHLARGESTUNIQUE = .getkey(.Count - Nth)
End With
Whoops:
End Function

And if you wanted to allow the function to ignore errors, blanks and text within the range, then I believe you could do this instead...


Function NTHLARGESTUNIQUE(InpData As Variant, Optional ByVal Nth As Long = 1) As Variant
Dim V As Variant, Arry As Variant
NTHLARGESTUNIQUE = CVErr(xlErrValue)
On Error GoTo Whoops
Arry = InpData
With CreateObject("System.Collections.SortedList")
For Each V In Arry
If IsNumeric(V) Then .Item(V) = Empty
Next
If .Count Then NTHLARGESTUNIQUE = .getkey(.Count - Nth)
End With
Whoops:
End Function

[Admin]

In general, we look these kind of things in either on a single column or row. In fact I made this UDF for someone who asked this question somewhere on net.

Thanks for making this UDF more generic :)