 Microsoft Access Office VB VBA Help and Examples @import url(http://www.google.com/cse/api/branding.css);   HOME MS ACCESS MS OUTLOOK MS EXCEL VB and VBA FREE PROGRAMS PERSONAL
 ACCESS GENERAL QUERIES FORMS REPORTS MODULES RANTS TUTORIALS

# Calculating the Weighted Median of a Recordset

To calculate the weighted median of a set of numbers you need to find the median and if this number does not exist in the recordset take the average of the values above and below the median instead.

Weighted Median of 1,2,3,4,5 is 3 (Median is also 3)
Weighted Median of 1,2,3,4,5,6 is 3.5 (Median is also 3.5)
Weighted Median of 1,2,4,4,4,7,7,8,8,8 is 5.2 (((4+4+4) + (7+7))/5) (Median is 5.5)

The function below shows you how to calculate the weighted median in access. Paste the following into a new or existing module and call it from anywhere to get the weighted median of a field in any recordset.

Please note there is no error handling so make sure the field is a valid number and the recordset exists and has one or more records.

The test sub shows you how to call it. This was built in the Northwind database so you can use it there for test purposes.

 Public Function WeightedMedianOfRst(RstName As String, fldName As String) As Double      'This function will calculate the weighted median of a recordset. The field must be a number value.      Dim MedianTemp As Double      Dim ThisValue As Double      Dim NumRecs As Long      Dim RstOrig As Recordset      Set RstOrig = CurrentDb.OpenRecordset(RstName, dbOpenDynaset)      RstOrig.Sort = fldName      Dim RstSorted As Recordset      Dim RstFiltered As Recordset      Set RstSorted = RstOrig.OpenRecordset()      If RstSorted.RecordCount Mod 2 = 0 Then           RstSorted.AbsolutePosition = (RstSorted.RecordCount / 2) - 1           ThisValue = RstSorted.Fields(fldName).Value           RstOrig.Filter = "[" & fldName & "] = " & ThisValue           Set RstFiltered = RstOrig.OpenRecordset()           MedianTemp = ThisValue * RstFiltered.RecordCount           NumRecs = RstFiltered.RecordCount           RstSorted.MoveNext           ThisValue = RstSorted.Fields(fldName).Value           RstOrig.Filter = "[" & fldName & "] = " & ThisValue           Set RstFiltered = RstOrig.OpenRecordset()           NumRecs = NumRecs + RstFiltered.RecordCount           MedianTemp = MedianTemp + ThisValue * RstFiltered.RecordCount           MedianTemp = MedianTemp / NumRecs      Else           RstSorted.AbsolutePosition = (RstSorted.RecordCount - 1) / 2           MedianTemp = RstSorted.Fields(fldName).Value      End If      WeightedMedianOfRst = MedianTemp End Function Private Sub test()      MsgBox MedianOfRst("Orders", "Freight") End Sub