Nth Largest Unique Value in an Array (UDF)

Hi All,

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

Code:

---

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

Code:

---

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

Quote:

---

Originally Posted by Admin

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

Thanks Rick :)

Quote:

---

Originally Posted by Admin

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

Code:

---

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

Code:

---

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

---

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 :)