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:
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