Hi JMK,
For some reason I did not get a notification of your reply and delayed
posting this and after a while I thought I would post what I had done so far
only to see that you had replied.
Anyway you indicated that you are trying it alone with Graham’s function but
as I have already done some work on it then thought you might like to have
it. You might get some ideas for your code.
Note that the entire project would be better with a form to enter the
parameters but I can’t post all that for you so it is another project for you
to create a form and remove the input boxes.
Open Access.
Create a new blank database and save.
Select File -> Get External Data -> Import.
Select the database where you have the table with your list of data.
In the Tables tab select ONLY the required table and click OK.
After the table is imported, make a note of the Table Name and the Field
Name for the input data. You will need them later.
Copy all of the code below into a module. (If Option Compare Database and/or
Option Explicit appears at the top of the editor window then don’t over
write them.)
While in the VBA Editor, Select menu Item Tools -> References.
Scroll down to Microsoft DAO 3.6 Object Library.
Check the box (Ensure you check the box not just select the item).
Click OK.
Click on Save to save the module.
You can run the code from within the VBA window.
Click anywhere within the first sub “Enter_Parametersâ€
Select menu Item Run. (There is also a toolbar button for run but I am not
sure if it is there by default or I added it to my toolbar)
(If you get an error on line ‘Dim rs as DAO.Recordset’ then it is because
the reference Microsoft DAO 3.6 Object Library has not been added as above.)
You will be requested to enter the Input Table name, the Input Table Field
Name, whether you wish to Interpolate and the Starting Percentile. Whatever
number is entered as the starting percentile will increment by these values
up to 100. (I have defaulted the code to Percentile because that was your
original question although the function handles other Quantiles.)
Return to Database window and view the output in table “QuantileOutputâ€
Copy all the following code into a module.
Sub Enter_Parameters()
Dim i As Double
Dim sqlStmt As String
Dim rs As DAO.Recordset
Dim strTblInput As String
Dim strFldInput As String
Dim lngSteps As String
Dim strInterpolate As String
Dim bolInterpolate As Boolean
Dim lngValue As Long
Do While TblExist(strTblInput) = False
strTblInput = InputBox _
("Enter name for the Input table" & _
Chr(13) & "Cancel to exit processing")
If strTblInput = "" Then
MsgBox "No Input or Cancelled by user" _
& Chr(13) & "Processing will terminate"
Exit Sub
End If
'Call function to test that Input table exists
If TblExist(strTblInput) Then
Exit Do
Else
MsgBox "Table does not exist. Re-enter"
End If
Loop
Do
strFldInput = InputBox _
("Enter the name of the field for the Input data" & _
Chr(13) & "Cancel to exit processing")
If strTblInput = "" Then
MsgBox "No Input or Cancelled by user" _
& Chr(13) & "Processing will terminate"
Exit Sub
End If
'Call function to test that field exists
If fldExists(strTblInput, strFldInput) = True Then
Exit Do
Else
MsgBox "Field does not exist. Re-enter"
End If
Loop
Do
lngSteps = InputBox("Enter the starting percentile." _
& Chr(13) & _
"Calculations will step by the entered value")
If lngSteps > 0 And lngSteps <= 100 Then
Exit Do
Else
MsgBox "Must be between 1 and 100. Re-enter"
End If
Loop
Do
strInterpolate = InputBox _
("Enter Y or N to interpolate value" & _
Chr(13) & "Cancel to exit processing")
If strInterpolate = "" Then
MsgBox "No Input or Cancelled by user" _
& Chr(13) & "Processing will terminate"
Exit Sub
End If
Select Case UCase(strInterpolate)
Case "Y", "T"
bolInterpolate = True
Exit Do
Case "N", "F"
bolInterpolate = False
Exit Do
Case Else
MsgBox "Must be Y or N"
End Select
Loop
'Create output table (or delete existing data if exists)
Call Create_Table
'Open the Output table ready to receive data
sqlStmt = "SELECT QuantileOutput.* FROM QuantileOutput;"
Set rs = CurrentDb.OpenRecordset(sqlStmt)
For i = lngSteps To 100 Step lngSteps
lngValue = Quantile(strTblInput, strFldInput, i, _
100, bolInterpolate)
With rs
.AddNew
.Fields("Percentile") = i
.Fields("ReturnedValue") = lngValue
.Update
End With
Next
End Sub
Sub Create_Table()
Dim dbs As Database
Dim tdfNew As TableDef
If TblExist("QuantileOutput") Then
GoTo deleteExistData
End If
Set dbs = CurrentDb
'Create a new TableDef object.
Set tdfNew = dbs.CreateTableDef("QuantileOutput")
With tdfNew
' Create fields and append them to the new TableDef object.
.Fields.Append .CreateField("Percentile", dbLong)
.Fields.Append .CreateField("ReturnedValue", dbLong)
End With
' Append the new TableDef object to the database
dbs.TableDefs.Append tdfNew
Exit Sub
'If table already exists, delete existing data
deleteExistData:
CurrentDb.Execute "Delete * from [QuantileOutput]"
End Sub
Public Function Quantile( _
rs As Variant, _
Fldname As String, _
Q As Double, _
N As Integer, _
Optional Interpolate As Boolean = True) As Double
'-----------------------------------------------------------------
' Calculate a given quantile from the numeric values in a recordset
' © Graham Mandeno, 2008
' Use freely provided this comment block is preserved.
'
' ARGUMENTS:
' rs : either an already opened DAO.Recordset
' or a string to be passed to db.OpenRecordset
' FldName : the name of a numeric field in the recordset
' Q : the degree of the quantile to be ascertained
' N : the number of the quantile to be ascertained
' Interpolate : if False, take closer actual value
' if True then interpolate between values
' (optional, default True)
' For example:
' Q = 75, N = 100 gives upper quartile
' Q = 3, N = 10 gives 3rd decile
' Q = 50, N = 100 gives median
'-----------------------------------------------------------------
Dim qVal As Double
Dim xRec As Double
Dim iRec As Long
Dim rsLocal As DAO.Recordset
Dim rsSorted As DAO.Recordset
Dim fCloseRS As Boolean
Dim recNumb As Double
On Error GoTo ProcErr
If Q < 0 Or Q > N Then
Err.Raise 5, "Quantile", _
"Quantile value must be in the range 0 to N"
End If
Select Case VarType(rs)
Case vbString
Set rsLocal = CurrentDb.OpenRecordset(rs, dbOpenSnapshot)
fCloseRS = True
Case vbObject
If TypeOf rs Is DAO.Recordset Then
Set rsLocal = rs
Else
Err.Raise 5, "Quantile", "Invalid recordset passed"
End If
Case Else
Err.Raise 5, "Quantile", "Invalid recordset passed"
End Select
rsLocal.Filter = Fldname & " is not Null"
rsLocal.Sort = Fldname
Set rsSorted = rsLocal.OpenRecordset()
With rsSorted
.MoveLast
.MoveFirst
xRec = (.RecordCount - 1) * Q / N + 1
'xRec now contains the record number we are looking for.
'(may not be a whole number)
iRec = Int(xRec)
xRec = xRec - iRec
If Not Interpolate And xRec >= 0.5 Then iRec = iRec + 1
'iRec now contains first record to look at and
'xRec contains interpolation to next record
.Move iRec - 1
qVal = .Fields(Fldname)
If Interpolate And xRec > 0 Then
.MoveNext
qVal = ((.Fields(Fldname) - qVal) * xRec) + qVal
End If
End With
Quantile = qVal
ProcEnd:
On Error Resume Next
If Not rsSorted Is Nothing Then
rsSorted.Close
Set rsSorted = Nothing
End If
If Not rsLocal Is Nothing Then
If fCloseRS Then rsLocal.Close
Set rsLocal = Nothing
End If
Exit Function
ProcErr:
MsgBox Err.Description, vbExclamation, _
"Error calculating Quantile"
Resume ProcEnd
End Function
Public Function TblExist(TblName As String) As Boolean
Dim tblDef As DAO.TableDef
'Adapted from Stuart McCall's Microsoft Access Pages - Tables
For Each tblDef In CurrentDb.TableDefs
If tblDef.Name = TblName Then
TblExist = True
Exit For
Else
TblExist = False
End If
Next tblDef
End Function
Public Function fldExists(TblName As String, _
Fldname As String) As Boolean
Dim rs As DAO.Recordset
Dim strFld As String
Set rs = CurrentDb.OpenRecordset(TblName)
On Error Resume Next
strFld = rs.Fields(Fldname).Name
fldExists = (Err.Number = 0)
On Error GoTo 0
DoCmd.Close acTable, rs.Name
Set rs = Nothing
End Function
--
Regards,
OssieMac
JMK said:
G'Day OssieMac and Graham,
Again, thank you for the responses.
To answer both your questions about the type of percentile I need to know
what percentile the value falls into, so the person achieved a mark say of
80% on an exam, and when compared to all others in the class they are in the
79th percentile (if that makes any sense).
I'll be giving Grahams formula a go today, so will let you know how things
go (of course substituting those values where OssieMac pointed out).
Thanks again!
Graham Mandeno said:
Hi OssieMac
Thanks! And yes, you are quite right. It was after 11pm when I was writing
the code and I changed a variable name at the last minute and didn't even
recompile <blush>
It was actually your link to the Wikipedia article that got me interested.
I found this reference
http://en.wikipedia.org/wiki/Quantile and based my
algorithm on that. The Interpolate argument (probably better named
"Weighted") switches between calculating the weighted average between the
two possible samples (the Excel algorithm) and simply taking the closer of
the two.
It would also improve the performance of the function to pass it an argument
to indicate that the recordset is already sorted and filtered for nulls.
Then it could be assigned directly to rsSorted.
Feel free to continue helping JMK with this. I'll monitor the thread
anyway. Looking back at JMK's posts, I wonder if he/she wants to ascertain
which percentile a given value falls in, not ascertain the value at a given
percentile. The approach would be somewhat different.
--
Good Luck
Graham Mandeno [Access MVP]
Auckland, New Zealand
OssieMac said:
Very good Graham and it seems a shame being critical but I think you might
need to substitute Q for V in both the following lines. Probably an after
thought to change the variable but not to worry because now I don't feel
so
bad about having done that sort of thing myself.
If V < 0 Or V > N Then
xRec = (.RecordCount - 1) * V / N + 1
I tested your function against the Excel Percentile function with 400
random
numbers and it works well.
Now to the OP. If you want to answer my previous questions then I can put
Graham's function to good use (Unless of course Graham wants to continue
with
his good work and finish it for you. If you do Graham then let me know and
I'll bow out.)
--
Regards,
OssieMac
:
Hi JMK
I haven't tested it thoroughly, but I think the following code will
return
the same result as the builtin function in Excel:
Public Function Quantile( _
rs As Variant, _
FldName As String, _
Q As Double, _
N As Integer, _
Optional Interpolate As Boolean = True _
) As Double
'-----------------------------------------------------------------
' Calculate a given quantile from the numeric values in a recordset
' Graham Mandeno, 2008
' Use freely provided this comment block is preserved.
'
' ARGUMENTS:
' rs : either an already opened DAO.Recordset
' or a string to be passed to db.OpenRecordset
' FldName : the name of a numeric field in the recordset
' Q : the degree of the quantile to be ascertained
' N : the number of the quantile to be ascertained
' Interpolate : if False, take closer actual value
' if True then interpolate between values
' (optional, default True)
' For example:
' Q = 75, N = 100 gives upper quartile
' Q = 3, N = 10 gives 3rd decile
' Q = 50, N = 100 gives median
'-----------------------------------------------------------------
Dim qVal As Double
Dim xRec As Double
Dim iRec As Long
Dim rsLocal As DAO.Recordset
Dim rsSorted As DAO.Recordset
Dim fCloseRS As Boolean
On Error GoTo ProcErr
If V < 0 Or V > N Then
Err.Raise 5, "Quantile", _
"Quantile value must be in the range 0 to N"
End If
Select Case VarType(rs)
Case vbString
Set rsLocal = CurrentDb.OpenRecordset(rs, dbOpenSnapshot)
fCloseRS = True
Case vbObject
If TypeOf rs Is DAO.Recordset Then
Set rsLocal = rs
Else
Err.Raise 5, "Quantile", "Invalid recordset passed"
End If
Case Else
Err.Raise 5, "Quantile", "Invalid recordset passed"
End Select
rsLocal.Filter = FldName & " is not Null"
rsLocal.Sort = FldName
Set rsSorted = rsLocal.OpenRecordset()
With rsSorted
.MoveLast
.MoveFirst
xRec = (.RecordCount - 1) * V / N + 1
'xRec now contains the record number we are looking for.
'(may not be a whole number)
iRec = Int(xRec)
xRec = xRec - iRec
If Not Interpolate And xRec >= 0.5 Then iRec = iRec + 1
'iRec now contains first record to look at and
'xRec contains interpolation to next record
.Move iRec - 1
qVal = .Fields(FldName)
If Interpolate And xRec > 0 Then
.MoveNext
qVal = ((.Fields(FldName) - qVal) * xRec) + qVal
End If
End With
Quantile = qVal
ProcEnd:
On Error Resume Next
If Not rsSorted Is Nothing Then
rsSorted.Close
Set rsSorted = Nothing
End If
If Not rsLocal Is Nothing Then
If fCloseRS Then rsLocal.Close
Set rsLocal = Nothing
End If
Exit Function
ProcErr:
MsgBox Err.Description, vbExclamation, "Error calculating Quantile"
Resume ProcEnd
End Function
--
Good Luck
Graham Mandeno [Access MVP]
Auckland, New Zealand
Hi All,
I've read at other sites on-line that to calculate Percentiles in
Access
you
need to write some VBA code or export the data to Excel.
While I know a little bit of how to write VBA code, I do not know how
the
results are stored. And by little bit, I mean I know how to change a
buttons
name from one thing to another, or show a calendar, or not show a
calendar -
thats about it.
What I really want to do, is once the percentiles are calculated, I
would
like to export these results to a table for further analysis.
I was wondering if anyone could provide me with the details on how to
code
this.
Thanks ahead of time!
