Doug, have pasted in the module code below. Scroll down a bit and you can
see the FMin function that I am trying to use. Thanks in advance for any
insight
James
Option Compare Database 'Use database order for string comparisons
Option Explicit
'
' These functions provide similar functionality to
' Domain functions, except, the values are passed
' in a string.
'
' e.g. Debug.Print FAvg("1,2,3,4,5")
'
' For summing fields, you can do the following in a controlsource:
' =FSum("|Field0]|,|[Field1]|,|[Field2]|")
'
' Nulls are ignored as they are in Domain functions
' Items must be separated by commas
'
Dim FFieldCount As Double
Function FAvg(S)
'
' Returns the average of valid numbers in the list supplied
'
Dim Tot As Double, i As Integer, x, NullCount As Integer
FGetNumberCount S
Tot = 0
NullCount = 0
For i = 1 To FFieldCount
x = FGetNumber(S, i)
If IsNumeric(x) Then
Tot = Tot + Val(x)
Else
NullCount = NullCount + 1
End If
Next i
If NullCount = FFieldCount Then
FAvg = Null
Else
FAvg = Tot / (FFieldCount - NullCount)
End If
End Function
Function FCount(S)
'
' Returns a count of valid numbers in the list supplied
'
Dim NullCount As Integer, i As Integer, x
FGetNumberCount S
NullCount = 0
For i = 1 To FFieldCount
x = FGetNumber(S, i)
If IsNumeric(x) Then NullCount = NullCount + 1
Next i
FCount = NullCount
End Function
Function FGetNumber(S, Item As Integer) As String
'
' Returns the number at "Item" position
' Assumes you've already run FGetNumberCount
'
Dim SPos As Long, EPos As Long, WordCount As Long, x
If VarType(S) <> 8 Then
FGetNumber = ""
Else
SPos = 1
If Item > FFieldCount Or Item < 1 Then
FGetNumber = ""
Else
WordCount = 1
Do While WordCount < Item
If Mid(S, SPos, 1) = "," Then WordCount = WordCount + 1
SPos = SPos + 1
Loop
EPos = SPos
Do While Mid(S, EPos, 1) <> "," And EPos <= Len(S)
EPos = EPos + 1
Loop
x = Eval(Mid(S, SPos, EPos - SPos))
If IsNumeric(x) Then
FGetNumber = x
Else
FGetNumber = ""
End If
End If
End If
End Function
Sub FGetNumberCount(S)
'
' Counts the number of items but not generic for fields
' since [abc,def] would register as two separate items.
'
Dim i As Long
If VarType(S) <> 8 Then
FFieldCount = 0
Else
S = Replace(S, "(", "") 'added to remove any brackets in function string
being passed
S = Replace(S, ")", "") 'added to remove any brackets in function string
being passed
FFieldCount = 1
For i = 1 To Len(S)
If Mid(S, i, 1) = "," Then FFieldCount = FFieldCount + 1
Next i
End If
End Sub
Function FMax(S)
'
' Returns the Maximum number in the list supplied
'
Dim Max As Double, i As Integer, AValue As Integer, x
FGetNumberCount S
If FFieldCount = 0 Then
FMax = Null
Else
AValue = False
For i = 1 To FFieldCount
x = FGetNumber(S, i)
If IsNumeric(x) Then
If AValue Then
If Val(x) > Max Then Max = Val(x)
Else
Max = Val(x)
AValue = True
End If
End If
Next i
If AValue Then
FMax = Max
Else
FMax = Null
End If
End If
End Function
Function FMin(S)
'
' Returns the Minimum number in the list supplied
'
Dim Min As Double, i As Integer, AValue As Integer, x
FGetNumberCount S
If FFieldCount = 0 Then
FMin = Null
Else
AValue = False
For i = 1 To FFieldCount
x = FGetNumber(S, i)
If IsNumeric(x) Then
If AValue Then
If Val(x) < Min Then Min = Val(x)
Else
Min = Val(x)
AValue = True
End If
End If
Next i
If AValue Then
FMin = Min
Else
FMin = Null
End If
End If
End Function