Median Function

[wisni1rr]

I am using this module in my access database for median :

Public Function DMedian( _
 ByVal strField As String, ByVal strDomain As String, _
 Optional ByVal strCriteria As String) As Variant

    ' Purpose:
    '     To calculate the median value
    '     for a field in a table or query.
    ' In:
    '     strField: the field
    '     strDomain: the table or query
    '     strCriteria: an optional WHERE clause to
    '                  apply to the table or query
    ' Out:
    '     Return value: the median, if successful;
    '                   Otherwise, an Error value.

    Dim db As DAO.Database
    Dim rstDomain As DAO.Recordset
    Dim strSQL As String
    Dim varMedian As Variant
    Dim intFieldType As Integer
    Dim intRecords As Integer
    
    Const errAppTypeError = 3169
    
    On Error GoTo HandleErr

    Set db = CurrentDb()
    
    ' Initialize return value
    varMedian = Null
    
    ' Build SQL string for recordset
    strSQL = "SELECT " & strField & " FROM " & strDomain
    
    ' Only use a WHERE clause if one is passed in
    If Len(strCriteria) > 0 Then
        strSQL = strSQL & " WHERE " & strCriteria
    End If
    
    strSQL = strSQL & " ORDER BY " & strField
    
    Set rstDomain = db.OpenRecordset(strSQL, dbOpenSnapshot)
    
    ' Check the data type of the median field
    intFieldType = rstDomain.Fields(strField).Type
    Select Case intFieldType
    Case dbByte, dbInteger, dbLong, dbCurrency, dbSingle, dbDouble, dbDate
        ' Numeric field
        If Not rstDomain.EOF Then
            rstDomain.MoveLast
            intRecords = rstDomain.RecordCount
            ' Start from the first record
            rstDomain.MoveFirst
    
            If (intRecords Mod 2) = 0 Then
                ' Even number of records
                ' No middle record, so move to the
                ' record right before the middle
                rstDomain.Move ((intRecords \ 2) - 1)
                varMedian = rstDomain.Fields(strField)
                ' Now move to the next record, the
                ' one right after the middle
                rstDomain.MoveNext
                ' And average the two values
                varMedian = (varMedian + rstDomain.Fields(strField)) / 2
                ' Make sure you return a date, even when
                ' averaging two dates
                If intFieldType = dbDate And Not IsNull(varMedian) Then
                    varMedian = CDate(varMedian)
                End If
            Else
                ' Odd number or records
                ' Move to the middle record and return its value
                rstDomain.Move ((intRecords \ 2))
                varMedian = rstDomain.Fields(strField)
            End If
        Else
            ' No records; return Null
            varMedian = Null
        End If
    Case Else
        ' Non-numeric field; so raise an app error
        Err.Raise errAppTypeError
    End Select

    DMedian = varMedian
    
ExitHere:
    On Error Resume Next
    rstDomain.Close
    Set rstDomain = Nothing
    Exit Function

HandleErr:
    ' Return an error value
    DMedian = CVErr(Err.Number)
    Resume ExitHere
End Function

Rather than finding text strings on the form/report, I have set up an expression in the control source. Where the field in question is SalePrice and the table in question is GENERAL.

=DMedian("SoldPrice","GENERAL")

However it returns "#Error" in the control.

Any Ideas on what is going wrong?

The field in question a currency datatype.

[NeoPa]

Wisni1rr:
Where the field in question is SalePrice and the table in question is GENERAL.

=DMedian("[U][B]Sold[/B][/U]Price","GENERAL")

I expect it's the wrong field name.

[wisni1rr]

Thank you, NeoPa.

The field in question is SoldPrice from the GENERAL table. The CODE was posted correctly in the first post.

=DMedian("SoldPrice","GENERAL")

The first post was incorrect in regards to the field in question.

[NeoPa]

So does that mean it's working now?

[wisni1rr]

No. The error still exists.

I also have the same error when trying with a different field.

I am using the code as an expression in the ControlSource Property.

=DMedian("SoldPrice","GENERAL")

and

=DMedian("DOM","GENERAL")

SoldPrice is a number datatype set as currency and DOM is a calculated field returning a number.

Both read as #ERROR in report view.

[NeoPa]

In that case I see nothing immediately likely to cause that, but you've posted a hundred lines of code there so you'll be lucky if someone goes through it all for you very carefully.

Have you considered calling it directly from the Immediate pane and tracing the execution to see where it behaves differently from what you'd expect (Debugging in VBA)?

[wisni1rr]

I tried to debug and did not come back with any halts.

However, I noticed that I do not have the Microsoft DAO 3.6 Object Library activated under my VBA references. I tried to activate and it and get an error dialogue saying "Name conflicts with existing module, project, or object library." I do not have any other modules in the current database. I also tried to add the reference in a new database and received the same error.

Could this be the culprit?

[Rabbit]

Do those fields contain a lot of nulls? I don't remember if the code handled nulls. Also, you said your DOM field is a calculated field... like in a query? But you also said GENERAL is a table. Your calculated query field isn't going to exist in your table.

[wisni1rr]

The current dataset does not contain any nulls. DOM is in the table design view as a calculated datatype.

The recordset for the report comes from a simple select query.

[wisni1rr]

SOLVED!

I used the following code to calculate the median of the fields. Both fields in question have returned appropriate values in my first round of tests.

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

I also needed to enter this into the Declarations

Option Explicit

Thanks for your help guys!!!

[NeoPa]

Good to hear. I assume the problem was related to your missing reference, which in turn went unnoticed due to the lack of the Option Explicit. There's a lesson there whichever way it turned out ;-)

For some more helpful tips that may help avoid such errors in future see When Posting (VBA or SQL) Code. It's particularly important when posting, but some of the ideas also help in the general development of code.

[wisni1rr]

I suspect you are correct, NeoPa.

Thanks NeoPA
Thanks Rabbit