Help: Median function not releasing control back to calling query

tnmsr2010

Registered User.
Local time
Today, 14:31
Joined
Feb 20, 2013
Messages
25
Need help with Median function not totally releasing control back to the calling Access query. When I run query that calls the DMedian function results are display in Access and then Access seems to freeze if you click anything.

I believe the VBA code is somehow not fully/completed stopping and exiting or ending to return complete control back to the calling query. My DMedian query I got from MSDN wedsite and modified slightly for our application.

Could someone please take a look to see if you spot something I'm doing wrong, especially as it pertains to EXITING/ENDING and returning control back to calling query. Thanks in advance.

Here is code for DMedian:
Code:
Public Function DMedian(strDomain As String, strField As String, Optional strGroup1 As String, Optional strGroup2 As String) As Variant
    '*******************************************
    'Purpose:   Return median value for a field in a table or query recordset
    'Inputs:    strField: the field
    '           strDomain: the table or query
    '           strCriteria: an optional WHERE clause to apply to the table or query
    '           strGroup1: an optional GROUP BY clause to apply to the table or query
    '           strGroup2: an optional GROUP BY clause to apply to the table or query
    'Calling:   DMedian("numericfieldnametogetmedian", "tableorqueryname", "stringforwhereclause") <enter>
    'Output:    Returns 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 include group1 filter in WHERE clause if one is passed in
    If Len(strGroup1) > 0 Then
        strSQL = strSQL & " WHERE PERFORMER = '" & strGroup1 & "'"
        'use group2 as another filter in WHERE clause if one is passed in
        If Len(strGroup2) > 0 Then
            strSQL = strSQL & " AND NUM_LINES = " & strGroup2 & ""
        End If
    End If
    'added to see if it would help with slowness
    strSQL = strSQL & " AND APS_DATE Between GetStartDate() And GetEndDate()"
    strSQL = strSQL & " ORDER BY " & strField
    
    Debug.Print strSQL
    
    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
 

Users who are viewing this thread

Back
Top Bottom