Private Type MyVariables
strVarName As String * 10
lngVarValue As Double
End Type
Dim myVar() As MyVariables
'We use a ByRef argument so that we can return the
'new variable's name as well in addition to the
'result of the Evaluation
Private Function Evaluate(strExpression As String, ByRef LeftHandSide As String) As Double
Dim tmpString() As String
Dim LHS As String, RHS As String
Dim RHSBegin As Long
Dim lngLoop As Long
Dim tmpResult As Double
'Find out where in the Expression the Right Hand Side begins
RHSBegin = InStr(1, strExpression, "=", vbBinaryCompare)
'Sperate the Left Hand Side and Right Hand Side
LHS = Trim(Mid(strExpression, 1, RHSBegin - 1))
RHS = Trim(Mid(strExpression, RHSBegin))
'Split the RHS into blocks separated by
'a space
tmpString = Split(RHS, " ", -1, vbBinaryCompare)
'First take the second value (the first value
'is the = sign) in the RHS and
'assign it to the temorary result
tmpResult = Assign_Values_for_Variables(tmpString(LBound(tmpString) + 1))
'Do a loop from the third element to perform the evaluation
'If we encounter a Variable like "SqFt"
'then we take the value from the array
'which we have populated earlier by calling
'the Assign_Values_for_Variables function
For lngLoop = LBound(tmpString) + 2 To UBound(tmpString)
Select Case tmpString(lngLoop)
Case Is = "+"
tmpResult = tmpResult + CDbl(Assign_Values_for_Variables(tmpString(lngLoop + 1)))
lngLoop = lngLoop + 1
Case Is = "-"
tmpResult = tmpResult - CDbl(Assign_Values_for_Variables(tmpString(lngLoop + 1)))
lngLoop = lngLoop + 1
Case Is = "*"
tmpResult = tmpResult * CDbl(Assign_Values_for_Variables(tmpString(lngLoop + 1)))
lngLoop = lngLoop + 1
Case Is = "/"
tmpResult = tmpResult / CDbl(Assign_Values_for_Variables(tmpString(lngLoop + 1)))
lngLoop = lngLoop + 1
End Select
Next lngLoop
LeftHandSide = LHS
Evaluate = tmpResult
tmpResult = 0
LHS = ""
End Function
Private Function Assign_Values_for_Variables(uVariable As String) As Double
Select Case uVariable
Case Is = "SqFt"
Assign_Values_for_Variables = myVar(3).lngVarValue
Case Is = "CubicFt"
Assign_Values_for_Variables = myVar(4).lngVarValue
Case Is = "SqYd"
Assign_Values_for_Variables = myVar(5).lngVarValue
Case Is = "CubicYd"
Assign_Values_for_Variables = myVar(6).lngVarValue
Case Else
If IsNumeric(uVariable) Then
Assign_Values_for_Variables = CDbl(uVariable)
Else
MsgBox "Handle exceptions here"
End If
End Select
End Function
Private Sub Assign_And_Calculate_Area(Length As Long, Width As Long, Depth As Long)
'Assign Length, Width & Depth
'and calculate Areas using the following formulae
'SquareFeet = Length * Width
'CubicFeet = Length * Width * Depth
'SquareYards = SquareFeet / 9
'CubicYards = CubicFeet / 27
myVar(0).lngVarValue = Length
myVar(1).lngVarValue = Width
myVar(2).lngVarValue = Depth
'Calculate and store Sq Feet
myVar(3).lngVarValue = myVar(0).lngVarValue * myVar(1).lngVarValue
'Calculate and store Cubic Feet
myVar(4).lngVarValue = myVar(0).lngVarValue * myVar(1).lngVarValue * myVar(2).lngVarValue
'Calculate and store Sq Yards
myVar(5).lngVarValue = myVar(3).lngVarValue / 9
'Calculate and store Cubic Yards
myVar(6).lngVarValue = myVar(4).lngVarValue / 27
End Sub
Private Sub Command1_Click()
Dim NewVar As String
Dim EquationResult As Double
Assign_And_Calculate_Area 100, 50, 25
Text1.Text = "Dirt = CubicFt * 2800 / 2000"
EquationResult = Evaluate(Text1.Text, NewVar)
MsgBox NewVar & " = " & EquationResult
End Sub
Private Sub Form_Load()
'load and assign the variable names
ReDim myVar(6) As MyVariables
myVar(0).strVarName = "Length"
myVar(1).strVarName = "Width"
myVar(2).strVarName = "Depth"
myVar(3).strVarName = "SqFt"
myVar(4).strVarName = "CubicFt"
myVar(5).strVarName = "SqYd"
myVar(6).strVarName = "CubicYd"
End Sub