Microsoft Access Office VB VBA Help and Examples
           
             

Calculating the Percentile of a Recordset

It's very easy to calculate the percentile of a range of numbers in excel but access is a whole different ball game.

The following code allows you to do just that and can be pasted into either form code or a standalone module.

I've used the method of counting the number of records remove one times by percentile add one to give me the record number I'm looking for, which I believe is the exact way excel does it.

It will interpolate if the value being looked for exists between two records.

Please note there is no error handling so make sure the fields is a valid number and the recordset exists and has more than one record.

The test sub shows you how to call it.

Public Function PercentileRst(RstName As String, fldName As String, PercentileValue As Double) As Double
   'This function will calculate the percentile of a recordset.
   'The field must be a number value and the percentile has to 
   'be between 0 and 1.
   If PercentileValue < 0 Or PercentileValue > 1 Then
      MsgBox "Percentile must be between 0 and 1", vbOKOnly
   End If
   Dim PercentileTemp As Double
   Dim dbs As Database
   Set dbs = CurrentDb
   Dim xVal As Double
   Dim iRec As Long
   Dim i As Long
   Dim RstOrig As Recordset
   Set RstOrig = CurrentDb.OpenRecordset(RstName, dbOpenDynaset)
   RstOrig.Sort = fldName
   Dim RstSorted As Recordset
   Set RstSorted = RstOrig.OpenRecordset()
   RstSorted.MoveLast
   RstSorted.MoveFirst
   xVal = ((RstSorted.RecordCount - 1) * PercentileValue) + 1
   'x now contains the record number we are looking for. 
   'Note x may not be     whole number
   iRec = Int(xVal)
   xVal = xVal - iRec
   'i now contains first record to look at and 
   'x contains diff to next record
   RstSorted.Move iRec - 1
   PercentileTemp = RstSorted(fldName)
   If xVal > 0 Then
      RstSorted.MoveNext
      PercentileTemp = ((RstSorted(fldName) - PercentileTemp) * xVal) + PercentileTemp
   End If
   RstSorted.Close
   RstOrig.Close
   Set RstSorted = Nothing
   Set RstOrig = Nothing
   Set dbs = Nothing
   PercentileRst = PercentileTemp
End Function

Private Sub test()
   MsgBox PercentileRst("tbl_Main", "fld_Score", 0.95)
End Sub
 
HOME   SEARCH SITE   PRIVACY POLICY   CONTACT
The code and application content of this site is copyright of Smiley I.T. and as such reproduction in any form which is for commercial use requires the permission of the Webmaster. Any use of this code for non-commercial use only requires a link or comment back to the original page you took the code from.