Fast median function in VBA for ADO recordsets

I want to get the median from fairly large sql server tables in Excel VBA using an ADO recordset.  

Getting the median is a pain, even with SQL Server 2012+ (PERCENTILE_CONT)..

I have a simple routine to get the median from an ADO recordset with works fine with small data sets, but would like the fastest solution for larger ones.

Here is my function...

Is there a better way?

Public Function getMedian(sTable As String, sField As String, Optional sDateField As String) As Variant
    Application.Volatile    'to respond to recalc event (F9)
   'this will get the median value for a field, not including zeros
    Dim oRS As New ADODB.Recordset
    Dim oWS As Excel.Worksheet
    Dim iMiddle As Integer
    Dim lRecs As Long
    Dim l As Long
    Dim dblVal1 As Double
    Dim dblVal2 As Double
    Dim sSQL As String
    Dim sSheet As String
    Dim bFilterDate As Date
    'check if there is a db connection... if not kick out
    If Not chkConn Then GoTo exitMe
    'check if activesheet is ByDate... If so, then filter by the dates
    sSheet = ActiveWorkbook.ActiveSheet.Name
    'Debug.Print "activesheet: " & sSheet
    If sSheet = "ByDate" Then
        'check if there is sDateField... If not, kick out....
        If sDateField = "" Then GoTo exitMe
        bFilterDate = True
        Set oWS = ActiveWorkbook.Sheets(sSheet)
    End If
    oRS.CursorLocation = adUseClient
    'On Error GoTo errorMe
    sSQL = "select " & sField & " from " & sTable & _
        " WHERE " & sField & " <> 0"
     If bFilterDate Then
        sSQL = sSQL & " AND " & sDateField & " >= '" & oWS.Cells(1, 3).Value & _
            "' and " & sDateField & " <= '" & oWS.Cells(2, 3).Value & "'"
     End If
    sSQL = sSQL & " ORDER BY " & sField & ";"
    oRS.Open sSQL, goConn, adOpenForwardOnly, adLockReadOnly
    If oRS.BOF And oRS.EOF Then
        getMedian = "None"
        GoTo exitMe
    End If
    lRecs = oRS.RecordCount
    If lRecs < 2 Then
        getMedian = "N/A"
        GoTo exitMe
    End If
    iMiddle = Int(lRecs / 2)
    If lRecs / 2 = iMiddle Then
        'even number of recs, so then need to get average of the two
        'numbers in the middle
        For l = 1 To (iMiddle - 1)
            'go to the first of the two middle numbers
        dblVal1 = oRS.Fields(sField).Value
        dblVal2 = oRS.Fields(sField).Value
        getMedian = (dblVal1 + dblVal2) / 2
        'odd number of recs, so just go to the middle rec
        For l = 1 To (iMiddle - 1)    'already at first record so go one less than half
            'Debug.Print oRS.Fields(sField).Value
        getMedian = oRS.Fields(sField).Value
    End If
    If oRS.State = adStateOpen Then oRS.Close
    Set oRS = Nothing
    Set oWS = Nothing
    Exit Function
    MsgBox "Error in getMedian running sql " & sSQL & ". SKIPPING...."

End Function

Open in new window

Who is Participating?
Éric MoreauSenior .Net ConsultantCommented:
You are using MS SQL 2012 or better? surely faster to use the builtin Percentile_DISC as shown in
Éric MoreauSenior .Net ConsultantCommented:
just saw:

Getting the median is a pain, even with SQL Server 2012+ (PERCENTILE_CONT)..

dougfosterNYCAuthor Commented:
I say it is a pain because the syntax is complex, and I am dynamically creating the sql in vba, and I am looping through table/view fields and getting the median for each.  I was hoping I could get a fast solution with the recordset, since I'm graphing it in Excel.

It seems like it wouldn't be that hard... I was hoping there was a fast way to pull the xth record of a recordset, quickly.  but maybe not..
Éric MoreauSenior .Net ConsultantCommented:
you can use Move ( but that wouldn't always work depending on the cursor type you have.
All Courses

From novice to tech pro — start learning today.