ebmgh.com

Excel has a pair of useful built-in functions called SMALL and LARGE. Suppose you want to know the third-largest number in a column. Or you want to find the fourth-smallest.

The function LARGE returns the k^th largest value in a dataset. Entering

=LARGE(A1:A9,3) 

returns the third largest value in the range A1 to A9. The function is smart enough to ignore blank cells and text. However, if you have an error in a cells, the result of the formula will be an error.

Here are custom functions to replace the built-in ones, called MyLarge and MySmall. Their use is identical to the Excel version: just enter

=MYLARGE(A1:A9,3).

If you don’t know how to use these, check out the following: How do I… Create a user-defined function in Microsoft Excel at Tech Republic. Or you can download an example workbook with the functions.

Note that these functions call a subroutine called QuickSort, which I copied from John Walkenbach‘s book Power Programming with Excel VBA years ago. (Highly recommended if you use Excel a lot and want to learn to automate repetitive tasks or do more advanced stuff.)

Function MyLarge(x, k)
'Replicates Excel's LARGE function, but will not balk at errors
'Returns the k-th largest value in a data set.
'Usage: =MYLARGE(A1:A15,3), returns the third largest value in the range A1 to A15

Dim arr() As Double 'An array to hold the cell values
Dim i As Long  'counter for looping through the array
Dim n As Long  'n is the number of elements in array
Dim nrev As Long  'revised count of number of VALID elements in array x

nrev = -1
n = Int(x.Count)
ReDim arr(n) As Double

'Note that Excel ranges always start with an index = 1
For i = 1 To n
  If Not IsEmpty(x(i)) And Not IsError(x(i)) And IsNumeric(x(i)) Then
    nrev = nrev + 1
    arr(nrev) = x(i)
  End If
Next i

ReDim Preserve arr(nrev)
Call Quicksort(arr, 0, nrev)

On Error GoTo IndexError
  MyLarge = arr(nrev - k + 1)
  Exit Function

IndexError:
  MyLarge = CVErr(xlErrNum)

End Function

Function MySmall(x, k)
'Replicates Excel's SMALL function, but will not balk at errors
'Returns the k-th smallest value in a data set.
'Usage: =MYSMALL(A1:A15,3), returns the third smallest value in the range A1 to A15

Dim arr() As Double 'An array to hold the cell values
Dim i As Long  'counter for looping through the array
Dim n As Long  'n is the number of elements in array
Dim nrev As Long  'revised count of number of VALID elements in array x

nrev = -1
n = Int(x.Count)
ReDim arr(n) As Double

'Note that Excel ranges always start with an index = 1
For i = 1 To n
  If Not IsEmpty(x(i)) And Not IsError(x(i)) And IsNumeric(x(i)) Then
    nrev = nrev + 1
    arr(nrev) = x(i)
  End If
Next i

ReDim Preserve arr(nrev)
Call Quicksort(arr, 0, nrev)

On Error GoTo IndexError
  MySmall = arr(k - 1)
  Exit Function

IndexError:
  MySmall = CVErr(xlErrNum)

End Function

Sub Quicksort(values() As Double, ByVal min As Long, ByVal max As Long)

'A fairly efficient sort algorithm for sorting 1-dimensional arrays of numbers
'Source: Walkenbach, J., 1999, Power Programming for Excel/VBA

'values() is the 1-dimensional array to be sorted

'min is the array index for the beginning of slice of the array where the sort is to begin
'To sort the entire array, min = 0 or 1 (depending on what Base you are working in)

'max is the array index for the end of the part of the array to be sorted.
'To sort the entire array, use max = len(values)

'Note that this is an example of a *recursive algorithm*
'To understand recursive algorithms, first you have to understand recursive algorithms  

Dim med_value As String
Dim Hi As Long
Dim lo As Long
Dim i As Long

  ' If the list has only 1 item, it's sorted.
  If min >= max Then Exit Sub

  ' Pick a dividing item randomly.
  i = min + Int(Rnd(max - min + 1))
  med_value = values(i)

  ' Swap the dividing item to the front of the list.
  values(i) = values(min)

  ' Separate the list into sublists.
  lo = min
  Hi = max
  Do
    ' Look down from hi for a value < med_value.     Do While values(Hi) >= med_value
      Hi = Hi - 1
      If Hi <= lo Then Exit Do
    Loop

    If Hi <= lo Then       ' The list is separated.       values(lo) = med_value       Exit Do     End If     ' Swap the lo and hi values.     values(lo) = values(Hi)     ' Look up from lo for a value >= med_value.
    lo = lo + 1
    Do While values(lo) < med_value       lo = lo + 1       If lo >= Hi Then Exit Do
    Loop

    If lo >= Hi Then
      ' The list is separated.
      lo = Hi
      values(Hi) = med_value
      Exit Do
    End If

    ' Swap the lo and hi values.
    values(Hi) = values(lo)
  Loop ' Loop until the list is separated.

  ' Recursively sort the sublists.
  Quicksort values, min, lo - 1
  Quicksort values, lo + 1, max

End Sub