Access Cookbook - Ken Getz [127]
' 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 of 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
' Nonnumeric field; raise an app error.
Err.Raise acbcErrAppTypeError
End Select
acbDMedian = varMedian
ExitHere:
On Error Resume Next
rstDomain.Close
Set rstDomain = Nothing
Exit Function
HandleErr:
' Return an error value.
acbDMedian = CVErr(Err)
Resume ExitHere
End Function
The process of building the SQL string that defines the recordset is straightforward, except for the construction of the optional WHERE clause. Because strCriteria was defined as an optional parameter (using the Optional keyword), acbDMedian checks if a value was passed by checking that the string has a length greater than zero.
Once acbDMedian builds the SQL string, it creates a recordset based on that SQL string.
Next, acbDMedian checks the data type of the field: it will calculate the median only for numeric and date/time fields. If any other data type has been passed to acbDMedian, the function forces an error by using the Raise method of the Err object and then uses the special CVErr function in its error handler to send the error state back to the calling procedure:
' Check the data type of the median field.
intFieldType = rstDomain.Fields(strField).Type
Select Case intFieldType
Case dbByte, dbInteger, dbLong, dbCurrency, dbSingle, dbDouble, dbDate
' ... more code follows ...
Case Else
' Nonnumeric field; raise an app error.
Err.Raise acbcErrAppTypeError
End Select
' ... more code follows ...
ExitHere:
On Error Resume Next
rstDomain.Close
Set rstDomain = Nothing
Exit Function
HandleErr:
' Return an error value.
acbDMedian = CVErr(Err)
Resume ExitHere
End Function
If the field is numeric, the acbDMedian function checks to see if there are any rows in the recordset using the following If...Then statement, returning Null if there are no rows:
' Numeric field.
If Not rstDomain.EOF Then
' ... more code follows ...
Else
' No records; return Null.
varMedian = Null
End If
If there are rows, the function moves to the end of the recordset to get a count of the total number of records. This is necessary because the RecordCount property returns only the number of rows that have been visited. The code is:
rstDomain.MoveLast
intRecords = rstDomain.RecordCount
If the number of records is even, acbDMedian moves to the record just before the middle using the Move method, which allows you to move an arbitrary number of records from the current record. The number of records to move forward is calculated using the following formula:
intRecords \ 2 - 1
This tells Access to divide the total number of records by 2 and then subtract 1 from the result (because you are starting from the first record). For example, if you are on the first of 500 records, you would move (500 \ 2 - 1) = (250 - 1) = 249 records forward, which would bring you to the 250th record. Once the function has moved that many records, it's a simple matter to grab the value of the 250th and 251st records and divide the result by 2. This part of the function is shown here:
' 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
' Average the two values.
varMedian = (varMedian + rstDomain.Fields(strField)) / 2
Because acbDMedian supports dates, the function needs to make sure that a date value is returned when taking the average of two dates. The following code handles this:
' Make sure you return a date, even when
' averaging two dates.
If intFieldType