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(InpData.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 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

[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