Attribute VB_Name = "modMedian"
Option Compare Database   'Use database order for string comparisons
Option Explicit


Function DMedian(strFieldName As String, strDomainName As String, Optional varWhere As Variant) As Variant
' Function to calculate the Median numeric value of a column in a domain
' Input: Name of the field, Name of the domain, Predicate (optional) - all strings
' Output: Median numeric value or Null if the field is a string or error encountered
Dim db As Database, rst As Recordset
Dim strSQL As String, lngRecords As Long, intVarType As Integer
Dim varValue As Variant, lngRows As Long, strWhere As String
'On Error GoTo DMedianBail
    ' Set default return of Null
    DMedian = Null
    ' Check for possible "missing" third argument
    If Not IsMissing(varWhere) Then
        If VarType(varWhere) = vbString Then strWhere = varWhere
    End If
    ' Point to the current database
    Set db = DBEngine.Workspaces(0).Databases(0)
    ' Open the domain sorted by the field
    strSQL = "SELECT [" & strFieldName & "] FROM [" & strDomainName & "]"
    If Len(strWhere) <> 0 Then
        strSQL = strSQL & " WHERE " & strWhere
    End If
    strSQL = strSQL & " Order By [" & strFieldName & "];"
    Set rst = db.OpenRecordset(strSQL)
    ' If no rows, then return Null
    If rst.EOF Then
        rst.Close
        Exit Function
    End If
    ' Get the number of rows
    rst.MoveLast
    lngRecords = rst.RecordCount
    rst.MoveFirst
    intVarType = VarType(rst(strFieldName))
    ' If the data type of the field isn't a number, then return Null
    If intVarType < 2 Or intVarType > 7 Then
        rst.Close
        Exit Function
    End If
    ' Calculate the "middle" of the recordset
    lngRows = lngRecords \ 2
    ' If an even number, then do an average
    If lngRecords Mod 2 = 0 Then
        rst.Move lngRows - 1
        varValue = rst(strFieldName)
        rst.MoveNext
        varValue = (varValue + rst(strFieldName)) / 2
        Else
        rst.Move lngRows
        varValue = rst(strFieldName)
    End If
    DMedian = varValue
    ' Be sure to return the proper data type
    Select Case intVarType
        Case vbInteger
            DMedian = CInt(varValue)
        Case vbLong
            DMedian = CLng(varValue)
        Case vbSingle
            DMedian = CSng(varValue)
        Case vbDouble
            DMedian = CDbl(varValue)
        Case vbCurrency
            DMedian = CCur(varValue)
        Case vbDate
            DMedian = CDate(varValue)
    End Select
    rst.Close

DMedianBail:
    Exit Function

End Function


Function DGMean(strFieldName As String, strDomainName As String, Optional varWhere As Variant) As Variant
' Function to calculate the Median numeric value of a column in a domain
' Input: Name of the field, Name of the domain, Predicate (optional) - all strings
' Output: Median numeric value or Null if the field is a string or error encountered
Dim db As Database, rst As Recordset
Dim strSQL As String, lngRecords As Long, intVarType As Integer, dblMult As Double
Dim varValue As Variant, lngRows As Long, strWhere As String
On Error GoTo DGMeanBail
    ' Set default return of Null
    DGMean = Null
    ' Initialize the multiplier
    dblMult = 1
    ' Check for possible "missing" third argument
    If Not IsMissing(varWhere) Then
        If VarType(varWhere) = vbString Then strWhere = varWhere
    End If
    ' Point to the current database
    Set db = DBEngine.Workspaces(0).Databases(0)
    ' Open the domain sorted by the field
    strSQL = "SELECT [" & strFieldName & "] FROM [" & strDomainName & "]"
    If Len(strWhere) <> 0 Then
        strSQL = strSQL & " WHERE " & strWhere
    End If
    strSQL = strSQL & " Order By [" & strFieldName & "];"
    Set rst = db.OpenRecordset(strSQL)
    ' If no rows, then return Null
    If rst.EOF Then
        rst.Close
        Exit Function
    End If
    ' Get the number of rows
    rst.MoveLast
    lngRecords = rst.RecordCount
    rst.MoveFirst
    intVarType = VarType(rst(strFieldName))
    ' If the data type of the field isn't a number, then return Null
    If intVarType < 2 Or intVarType > 7 Then
        rst.Close
        Exit Function
    End If
    ' Loop to calculate the multiple of all values
    Do Until rst.EOF
        ' Skip 0 values
        If rst(strFieldName) <> 0 Then
            ' Multiply
            dblMult = dblMult * rst(strFieldName)
        End If
        rst.MoveNext
    Loop
    ' Calculate the Geometric mean = the nth root of the
    '  multiple of the values
    varValue = dblMult ^ (1 / lngRecords)
    
    ' Be sure to return the proper data type
    Select Case intVarType
        Case vbInteger
            DGMean = CInt(varValue)
        Case vbLong
            DGMean = CLng(varValue)
        Case vbSingle
            DGMean = CSng(varValue)
        Case vbDouble
            DGMean = CDbl(varValue)
        Case vbCurrency
            DGMean = CCur(varValue)
        Case vbDate
            DGMean = CDate(varValue)
    End Select
    rst.Close

DGMeanBail:
    Exit Function

End Function