Content
Resources
To Do
Toolbox

 EvalMixedNum

This function is similar to the builtin Eval function, but instead returns the value of a mixed number (ex. 1-1/4). This is useful in situations where the user might be entering a size dimension into an unbound field, or other situations where a user may desire to enter a fractional value in an unbound field.

Examples of valid numbers and returns when using IsMixedNumber and EvalMixedNum:

CODE
IsMixed: 1        True, Evals to: 1
IsMixed: 1.5      True, Evals to: 1.5
IsMixed: 1/2      True, Evals to: 0.5
IsMixed: -1/2     True, Evals to: -0.5
IsMixed: -1.75    True, Evals to: -1.75
IsMixed: 1 3/8    True, Evals to: 1.375
IsMixed: 1-3/8    True, Evals to: 1.375
IsMixed: -1 3/8   True, Evals to: -1.375
IsMixed: 1 15/2   True, Evals to: 8.5
IsMixed: +1-1/2   True, Evals to: 1.5
IsMixed: 1-3.5/8  False, Evals to: INVALID
IsMixed: 1.5-1/2  False, Evals to: INVALID

See comments in the function header for usage and notes throughout the function for some descriptions on what's going on.

Dependancies:
Office 2000 or later (or replacement Split() and Replace() functions)
IsMixedNumber
IsFraction

Function:

CODE
'==============================================================================
' NAME: EvalMixedNum
'
' Code courtesy of UtterAccess Wiki
' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary
'
' PURPOSE: Evaluates a mixed number or single fraction
' RETURNS: Double, number equivelant to the expression passed.  Returns 0
'          on errors, so make SURE the calling design is proofed well to avoid
'          mishaps.
'
' ARGUMENTS: sInput, string, an expression of one of the following syntaxes:
'     ARG      RET
'   "1-1/2"   (1.5)
'   "1 1/2"   (1.5)
'   "11/2"    (5.5)
'   "1"       (1)
'   "-2-7/8"  (-2.875)
'   "-2 7/8"  (-2.875)
'
' DEPENDANCIES:
'   Access 2000+ (requires Replace and Split functions for earlier versions)
'   IsMixedNumber() (http://www.utteraccess.com/wiki/index.php/IsMixedNumber)
'   IsFraction() (http://www.utteraccess.com/wiki/index.php/IsFraction)
'       *IsFraction is required indirectly by the IsMixedNumber function
'
'
' REVISIONS:
'  REV |    DATE    | REV TYPE | DESCRIPTION
'------------------------------------------------------------------------------
'  R01   2010/08/19   INITIAL
'  R02   2010/12/10   MINOR      Includes call to IsMixedNumber() to verify
'                                input, other general tidying-up
'
'
' NOTES:
'
'   This function does NOT handle expressions that contain multiple numbers.
'   For example, "1-1/2 + 2-3/8" is invalid and will fail.  The correct calling
'   structure for this expression would be:
'     =EvalMixedNum("1-1/2") + EvalMixedNum("2-3/8")
'
'==============================================================================
'ErrHandler V3.01
Public Function EvalMixedNum(ByVal sInput As String) As Double
On Error GoTo Error_Proc
Dim Ret As Double
'=========================

'Error constants
Const ERRN_EXPRESSION_SYNTAX As Long = vbObjectError + 7001
Const ERRM_EXPRESSION_SYNTAX As String = _
"The syntax [||] is not valid!"

'variables
Dim bIsNegative As Boolean  'flag this so we can negate the final value
Dim v As Variant  'variant array to store the elements of the expression.

'=========================

sInput = Trim(sInput)

If Not IsMixedNumber(sInput) Then
Err.Raise ERRN_EXPRESSION_SYNTAX, , _
Replace(ERRM_EXPRESSION_SYNTAX, "||", sInput)
GoTo Exit_Proc
End If

If Len(sInput) = 0 Then GoTo Exit_Proc

'eval for a negative value
If Left(sInput, 1) = "-" Then
bIsNegative = True
'trim the sign
sInput = Right(sInput, Len(sInput) - 1)
End If

'check for whole num to fraction seperator (space or dash)
If InStr(1, sInput, " ") <> 0 Then
'a space seperator is likely used
v = Split(sInput, " ")
ElseIf InStr(1, sInput, "-") <> 0 Then
'a dash seperator is likely used
v = Split(sInput, "-")
Else
'no sperator, should be a straight conversion
v = Split(sInput)
End If

'get the return
If UBound(v) = 0 Then
Ret = CDbl(Eval(v(0)))
Else
Ret = CDbl(Eval(v(0))) + CDbl(Eval(v(1)))
End If

'negate the return if required
If bIsNegative Then Ret = Ret * (-1)

'=========================
Exit_Proc:
EvalMixedNum = Ret
Exit Function
Error_Proc:
Select Case Err.Number
Case Else
MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Module: lmthNumberManips, Procedure: EvalMixedNum" _
, vbCritical, "Error!"
End Select
Resume Exit_Proc
Resume
End Function