Yes, you can use VBA with ADO to develop your own user-
defined aggregate functions. As an example, here is a
DMedian function I wrote to get the median of a data set:
Function DMedian(FieldName As String, Domain As String, _
Optional Criteria As String) As Variant
On Error GoTo Err
Dim SQLStr As String
Dim MedianRs As ADODB.Recordset
Dim RecordsReturned As Integer, EvenOdd As Boolean,
MedianRecord As Integer
Dim Median1 As Variant, Median2 As Variant
Dim TrueName As String
TrueName = Replace(FieldName, "[", "")
TrueName = Replace(TrueName, "]", "")
SQLStr = "SELECT " & FieldName & " FROM [" & Domain & "]"
If Not (Criteria = "") Then SQLStr = SQLStr & " WHERE " &
Criteria
SQLStr = SQLStr & " ORDER BY " & FieldName
Set MedianRs = New ADODB.Recordset
MedianRs.CursorLocation = adUseClient
MedianRs.CursorType = adOpenDynamic
MedianRs.Open SQLStr, CurrentProject.Connection,
adOpenDynamic, adLockReadOnly
RecordsReturned = MedianRs.RecordCount
If RecordsReturned = 0 Then GoTo Err
EvenOdd = (Int(RecordsReturned / 2) = (RecordsReturned /
2))
If EvenOdd Then
MedianRecord = Int(RecordsReturned / 2)
MedianRs.Move MedianRecord - 1, 1
Median1 = MedianRs.Fields(TrueName).Value
MedianRs.MoveNext
Median2 = MedianRs.Fields(TrueName).Value
DMedian = (Median1 + Median2) / 2
Else
MedianRecord = Int(RecordsReturned / 2) + 1
MedianRs.Move MedianRecord - 1, 1
DMedian = MedianRs.Fields(TrueName).Value
End If
If MedianRs.State = adStateOpen Then MedianRs.Close
Set MedianRs = Nothing
Exit Function
Err:
On Error Resume Next
If MedianRs.State = adStateOpen Then MedianRs.Close
Set MedianRs = Nothing
DMedian = CVErr(2001)
End Function
