Thursday, 15 October 2015

Calculating the median of a field

Access comes loaded with mathematical functions for all kinds of things, and it's easy to determine the sum, average, maximum or minimum of a field in a table, using either a query or some VBA. But what about some more complicated functions? What if you want to, for example, know the median value of a field in a table? For those of you whose maths is a bit rusty, the median is the value below which 50% of the data falls - the physical midpoint in a range, if you will. Access does provide a MEDIAN() worksheet function but this only works on a series of numbers rather than table data. It's still useful for illustrating exactly what a median is though - check out these examples:

MEDIAN(1, 2, 3, 4, 5) equals 3

MEDIAN(1, 2, 3, 4, 5, 6) equals 3.5, the average of 3 and 4

So anyway, you want to work out the median of a table field. The following function takes two parameters, the name of the table and the name of the field, both as strings. Note that if you have spaces in either name (naughty you) you'll need to enclose them in square brackets before you pass them to the function. Anyway, the function just returns the median value.

Function fctnMedian(strTable As String, strField As String) As Variant
    Dim dbs As DAO.Database, rst As DAO.Recordset 'You must add a reference to the DAO Object Library too
    Dim booEven as Boolean
    Set dbs = DBEngine(0)(0)
    Set rst = dbs.OpenRecordset("SELECT * FROM " & strTable & " ORDER BY " & strField)
    If rst.EOF = False Then
        rst.MoveLast
        booEven = (rst.RecordCount Mod 2 = 0) 'Is there an even number of records in the recordset?
        rst.PercentPosition = 50 'Rounds down if there is an even number of records...
        fctnMedian = rst.Fields(strField)
        If booEven Then
            rst.MoveNext
            fctnMedian = (fctnMedian + rst.Fields(strField)) / 2 'Takes average of this & the next value up
        End If
    End If
    rst.Close
    Set rst = Nothing
    Set dbs = Nothing
End Function

No comments:

Post a comment