Can I get the following function to work with Fieldnames that have
spaces in it? I've tried spqaure brackets to no avail.
Any help would be appreciated.
Public Function DMedian(FieldName As String, _
TableName As String, _
Optional Criteria As Variant) As Double
On Error GoTo Err_DMedian
'Returns the median of a given field in a given table.
'Returns -1 if no recordset is created
Dim conn As Connection
Dim rs As New ADODB.Recordset
Dim strSQL As String
Dim RowCount As Long
Dim LowMedian As Double, HighMedian As Double
'Open a recordset on the table.
Set conn = CurrentProject.Connection
strSQL = "SELECT " & FieldName & " FROM " & TableName
If Not IsMissing(Criteria) Then
strSQL = strSQL & " WHERE " & Criteria & " ORDER BY " &
FieldName
Else
strSQL = strSQL & " ORDER BY " & FieldName
End If
' Debug.Print strSQL
rs.Open strSQL, conn, adOpenKeyset, adLockOptimistic
'Find the number of rows in the table.
rs.MoveLast
RowCount = rs.RecordCount
rs.MoveFirst
If RowCount Mod 2 = 0 Then
'There is an even number of records. Determine the low and high
'values in the middle and average them.
rs.Move Int(RowCount / 2) - 1
LowMedian = rs(FieldName)
rs.Move 1
HighMedian = rs(FieldName)
DMedian = (LowMedian + HighMedian) / 2
Else
'There is an odd number of records. Return the value exactly in
'the middle.
rs.Move Int(RowCount / 2)
DMedian = rs(FieldName)
End If
Exit_DMedian:
Exit Function
Err_DMedian:
If Err.Number = 3075 Then
DMedian = 0
Resume Exit_DMedian
ElseIf Err.Number = 3021 Then
'EOF or BOF ie no recordset created
DMedian = -1
Resume Exit_DMedian
Else
MsgBox Err.Description
Resume Exit_DMedian
End If
End Function
