Help!! 'Median' Function Problem

[lilycao]

I need to have 'median' number of required data arrays in an access database. And I found on the internet the following function which i can compile into the module and be used.

The problem is that the function work well with tables and queries without criteria. However, the function can not work with queries with criteria. For example, if the query is named 'production query', I want to know the median value of its field 'rate', and the query has a criteria like 'between [Forms]![Date Buffer]![BeginDate] And [Forms]![Date Buffer]![EndDate]', then if we use the function as Median ("production query","rate"), access will pop up an error message 'Too few parameters, expected 2'.And i'm sure the 'begindate' and 'enddata' in the criteria is filled.
Thank you very much for any suggestion!!

The function code is as follows.
-----------------------------------------------------------------------
Function Median(tName As String, fldName As String) As Single
Dim MedianDB As DAO.Database
Dim ssMedian As DAO.Recordset
Dim RCount As Integer, i As Integer, x As Double, Y As Double, _
OffSet As Integer
Set MedianDB = CurrentDb
Set ssMedian = MedianDB.OpenRecordset("SELECT [" & fldName & _
"] FROM [" & tName & "] WHERE [" & fldName & _
"] IS NOT NULL ORDER BY [" & fldName & "];")
'NOTE: To include nulls when calculating the median value, omit
'WHERE [" & fldName & "] IS NOT NULL from the example.
ssMedian.MoveLast
RCount% = ssMedian.RecordCount
x = RCount Mod 2
If x <> 0 Then
OffSet = ((RCount + 1) / 2) - 2
For i% = 0 To OffSet
ssMedian.MovePrevious
Next i
Median = ssMedian(fldName)
Else
OffSet = (RCount / 2) - 2
For i = 0 To OffSet
ssMedian.MovePrevious
Next i
x = ssMedian(fldName)
ssMedian.MovePrevious
Y = ssMedian(fldName)
Median = (x + Y) / 2
End If
If Not ssMedian Is Nothing Then
ssMedian.Close
Set ssMedian = Nothing
End If
Set MedianDB = Nothing
End Function
-----------------------------------------------------------------------

 

[lilycao]

Several days no reply. Any clue that comes to your mind is welcome!
Call for help!!!

 

[Beetle]

When you open or run a parameterized query through the normal Access user interface, Access provides an expression service that evaluates the parameters, like references to form controls.

When you open or run the same query (or SQL statement) in code, you are bypassing the normal Access UI and passing the query directly to the Jet database engine. Jet knows nothing about your forms or their controls, so it cannot evaluate the parameters. You can solve this by using the QueryDef object. So, let's say you have a stored query called TestQuery, with references to form controls as criteria. Your function might be modified as follows;

This is untested air code because I don't have Access where I am right now, so it could have some syntax errors, but it should give you the basic idea. You can research the QueryDef object if you need more help.

Function Median(tName As String, fldName As String) As Single

Dim MedianDB As DAO.Database
Dim ssMedian As DAO.Recordset
Dim RCount As Integer, i As Integer, x As Double, Y As Double, OffSet As Integer
Dim qdf As QueryDef
Dim prm As Parameter

Set MedianDB = CurrentDb
Set qdf = MedianDB.QueryDef("TestQuery")

For Each prm in qdf.Parameters
      prm.Value = Eval(prm.Name)
Next prm

Set ssMedian = qdf.OpenRecordset(dbOpenDynaset)

ssMedian.MoveLast
RCount% = ssMedian.RecordCount
x = RCount Mod 2

If x <> 0 Then
    OffSet = ((RCount + 1) / 2) - 2
    For i% = 0 To OffSet
        ssMedian.MovePrevious
    Next i
    Median = ssMedian(fldName)
Else
    OffSet = (RCount / 2) - 2
    For i = 0 To OffSet
        ssMedian.MovePrevious
    Next i
    x = ssMedian(fldName)
    ssMedian.MovePrevious
    Y = ssMedian(fldName)
    Median = (x + Y) / 2
End If

If Not ssMedian Is Nothing Then
    ssMedian.Close
    Set ssMedian = Nothing
End If
Set MedianDB = Nothing

End Function

You can use the CreateQueryDef method of the QueryDef object to create queries on the fly using SQL statements (like in your original code example), evaluate any parameters like in the example, then open the record set for processing.

BTW - Code is a lot easier to read in the forum if you use the code tags to preserve spacing and indenting.

 

[lilycao]

Thank Beetle very much!! I haven't tested throughly, but I'm too thrilled that I can't wait to reply. The problem has bothered me so long.

Though I'm really a freshman in using access or SQL or VBA, I can understand the main idea of your explanation: using QueryDef in the code to re-introduce Access UI then to the Jet database engine.
And thank you for your code, even it is on-air, it is almost correct.
Except that
Set qdf = MedianDB.QueryDef("TestQuery")
shoud be
Set qdf = MedianDB.QueryDefs("TestQuery")
Just one little 's'.

By the way, when using this fuction, It seems that everytime we need to change the "TestQuery" in the code and maybe change the fuction name to avoid conflict. Is that right?

 

[lilycao]

Sorry, but the code seems to have a problem.

For example, if the query is named 'Test Query', I want to know the median value of its field 'rate', and the query has a criteria for field 'Date', like 'between [Forms]![Date Buffer]![BeginDate] And [Forms]![Date Buffer]![EndDate]', then if we use the function as Median ("production query","rate"), I want the returned value to be the median of 'rate', however the code return the 'rate' in the record of the median date. That is if date is between 2011-4-10 and 2011-4-20, it return the rate of 2011-4-15, even though that rate is not the median value of those 10days' rates.


Need your help again!!

 

[Beetle]

It sounds to me like you have your query sorted by the date. In order for this function to return the correct median value, the query must be sorted by the same field that contains the value that you are trying to find the median for. That's because the function merely finds the record(s) in the "middle", based on the total record count, and pulls the value from the field named in the functions arguments (or if the query has an even number of total records it pulls the values from the middle 2 records and divides by 2 to get the median). If the query is not sorted by the field used in the function arguments then you will likely get an incorrect answer.

By the way, when using this fuction, It seems that everytime we need to change the "TestQuery" in the code and maybe change the fuction name to avoid conflict. Is that right?

You should be able to just pass the query name to the function as an argument (i.e. instead of a table name use the query name)

 

[lilycao]

It sounds to me like you have your query sorted by the date. In order for this function to return the correct median value, the query must be sorted by the same field that contains the value that you are trying to find the median for.

Yes, I think that's the exact problem. The 'ssMedian' in the fuction (which is a dynaset recordset) seems to ordered according to the 'key field'. So I tried to sort this recordset according to the field that contains the value I'm trying to find the median for before the code goes to 'ssMedian.Movelast'.

However, I didn't find the way to change the 'sorting field' due to my lack of coding experience.
Do you have any suggestions? Thank you very much!

 

[lilycao]

Up,Up,UP!!

 

[Beetle]

Can you post your function as it is right now, as well as the SQL of the query (if you're using a stored query rather than a SQL statement in the function itself)?

 

[lilycao]

The median function code is as follows:

Function Median(tName As String, fldName As String) As Single
Dim MedianDB As DAO.Database
Dim ssMedian As DAO.Recordset
Dim RCount As Integer, i As Integer, x As Double, Y As Double, OffSet As Integer
Dim qdf As QueryDef
Dim prm As Parameter
Set MedianDB = CurrentDb
Set qdf = MedianDB.QueryDefs("KTJ2 Daily Operation Query")
For Each prm In qdf.Parameters
      prm.Value = Eval(prm.Name)
Next prm
Set ssMedian = qdf.OpenRecordset
ssMedian.MoveLast
RCount% = ssMedian.RecordCount
x = RCount Mod 2
If x <> 0 Then
    OffSet = ((RCount + 1) / 2) - 2
    For i% = 0 To OffSet
        ssMedian.MovePrevious
    Next i
    Median = ssMedian(fldName)
Else
    OffSet = (RCount / 2) - 2
    For i = 0 To OffSet
        ssMedian.MovePrevious
    Next i
    x = ssMedian(fldName)
    ssMedian.MovePrevious
    Y = ssMedian(fldName)
    Median = (x + Y) / 2
End If
If Not ssMedian Is Nothing Then
    ssMedian.Close
    Set ssMedian = Nothing
End If
Set MedianDB = Nothing
End Function

The query used in the fuction is 'KTJ2 Daily Operation Query', the SQL code of this query is as follows:

SELECT [KTJ2 Daily Operation SubQuery].*
FROM [KTJ2 Daily Operation SubQuery]
WHERE ((([KTJ2 Daily Operation SubQuery].Date) Between [Forms]![KPI Date Buffer]![BeginDate] And [Forms]![KPI Date Buffer]![EndDate]))
ORDER BY [KTJ2 Daily Operation SubQuery].Date;

 

[lilycao]

If you don't mind, would you please look at the result of the fuction in the attached word file, which is the screen shot of the progrmme.

 

[Beetle]

The code for that function was originally written to use a query that is built within the code from a SQL statement using the the table name and field name that are called in the functions arguments (tName and fldName).

If you want to use a stored query then the code requires more modification. In my previous post I was only addressing the use of QueryDefs. I was not evaluating the entire function. So, based on what you've said, here is what you need to do.

1) Modify your stored query to that it is sorted by the appropriate field (in this case CWTemp);


SELECT [KTJ2 Daily Operation SubQuery].*
FROM [KTJ2 Daily Operation SubQuery]
WHERE ((([KTJ2 Daily Operation SubQuery].Date) Between [Forms]![KPI Date Buffer]![BeginDate] And [Forms]![KPI Date Buffer]![EndDate]))
ORDER BY [KTJ2 Daily Operation SubQuery].CWTemp;

Then use this slightly modified version of the code;

Function Median(qName As String, fldName As String) As Single

Dim MedianDB As DAO.Database
Dim ssMedian As DAO.Recordset
Dim RCount As Integer, i As Integer, x As Double, Y As Double, OffSet As Integer
Dim qdf As QueryDef
Dim prm As Parameter

Set MedianDB = CurrentDb
Set qdf = MedianDB.QueryDefs(qName)

For Each prm In qdf.Parameters
      prm.Value = Eval(prm.Name)
Next prm

Set ssMedian = qdf.OpenRecordset
ssMedian.MoveLast

RCount% = ssMedian.RecordCount

x = RCount Mod 2

If x <> 0 Then
    OffSet = ((RCount + 1) / 2) - 2
    For i% = 0 To OffSet
        ssMedian.MovePrevious
    Next i
    Median = ssMedian(fldName)
Else
    OffSet = (RCount / 2) - 2
    For i = 0 To OffSet
        ssMedian.MovePrevious
    Next i
    x = ssMedian(fldName)
    ssMedian.MovePrevious
    Y = ssMedian(fldName)
    Median = (x + Y) / 2
End If

If Not ssMedian Is Nothing Then
    ssMedian.Close
    Set ssMedian = Nothing
End If
Set MedianDB = Nothing

End Function

The only real change to the function from the way you currently have it is this line;

Set qdf = MedianDB.QueryDefs(qName)

so you can just pass the query name to the function as an argument, rather than having the query name hard coded in the function. That way you can more easily call different queries in the function.

Then just call the function like you are now;

=Median("KTJ2 Daily Operation Query", "CWTemp")

 

[lilycao]

Thank you very much!!
I think It can work now.

Still I have a question: is it possible to skip the first step, which is to modify the stored queries, and compile the re-order action into the function itself.

Because the function may be used frequently in the database and it would be more universal and convenient not to change the cited queries which are used in other queries and forms.

Am I too greedy?

 

[Beetle]

I've been gone for a few days. Post back if you're still working on this.

 

[lilycao]

I have been gone for a few days too. Though the current solution is acceptible. I still would like to have a more perfect fuction which can be directly used in query with criteria. I used recordset.sort to reorder before recordset.movelast. But I don't know why it can't work.

 

[Beetle]

Give this a try.

Basically what this does is use the stored query name that is passed to the function as an argument, grabs the SQL of the query and creates a new SQL statement with a new ORDER BY clause based on the field name that is passed to the function. It then opens a temporary query def, based on the new SQL statement, to use for the record set. This way your stored queries can remain as is without being affected. You would still call the function the same as before;

=Median("YourQueryName", "YourFieldName")

Here is the modified code;

Function Median(qName As String, fldName As String) As Single
 
Dim MedianDB As DAO.Database
Dim ssMedian As DAO.Recordset
Dim RCount As Integer, i As Integer, x As Double, Y As Double, OffSet As Integer
Dim qdf As QueryDef, qdf2 As QueryDef
Dim prm As Parameter
Dim strSQL As String, strSQL2 As String, strSort As String
 
Set MedianDB = CurrentDb
 
'Get the stored query
Set qdf = MedianDB.QueryDefs(qName)
 
'Get the SQL of the stored query
strSQL = qdf.sql
 
'Grab everyting prior to the ORDER BY clause for the strSQL2 variable
strSQL2 = Left(strSQL, InStr(strSQL, "ORDER BY") - 1)
 
'Create a new ORDER BY clause using the field in the function arguments
strSort = "ORDER BY " & fldName
 
'Append the new ORDER BY clause to strSQL2
strSQL2 = strSQL2 & strSort
 
'Open a temporary querydef based on the new SQL (strSQL2)
Set qdf2 = MedianDB.CreateQueryDef("", strSQL2)
 
'Evaluate the parameters of the temp querydef
For Each prm In qdf2.Parameters
      prm.Value = Eval(prm.Name)
Next prm
 
'Open a recordset based on the temp querydef
Set ssMedian = qdf2.OpenRecordset
 
ssMedian.MoveLast
 
RCount% = ssMedian.RecordCount
 
x = RCount Mod 2
 
If x <> 0 Then
    OffSet = ((RCount + 1) / 2) - 2
    For i% = 0 To OffSet
        ssMedian.MovePrevious
    Next i
    Median = ssMedian(fldName)
Else
    OffSet = (RCount / 2) - 2
    For i = 0 To OffSet
        ssMedian.MovePrevious
    Next i
    x = ssMedian(fldName)
    ssMedian.MovePrevious
    Y = ssMedian(fldName)
    Median = (x + Y) / 2
End If
 
If Not ssMedian Is Nothing Then
    ssMedian.Close
    Set ssMedian = Nothing
End If
Set MedianDB = Nothing
 
End Function

Note: I have tested this, but only with one small query that I threw together. Generelly speaking it should work fine unless you have any queries that have more than one field with the same name (from different tables) and one of those fields happens to be the field you want to sort by. In that case the ORDER BY clause would need to include the table name as well, and I have not taken that into consideration in this example.

 

[lilycao]

I have tested your fuction. So far so good. You are so brilliant!!
Thank you very much！