Use the function Conditional to read the formatting.
Every time if comes across two characters in the fancy brackets {} it will call the procedure findcolcontents sending the two characters as the argument.
Remember that you can NEVER use ANY brackets inside brackets of you will have errors.
The function reads the string like this:
± = If
§ = And
¦ = Or
ó = Then
ô = Else
An example string:
±[5_+_{75} = {43}]ó(1)ô(2)
This converts to:
If 5 + findcolcontents(75) = findcolcontents(43) Then
Return = 1
Else
Return = 2
End if
'± 753 If
'§ 789 And
'¦ 698 Or
'ó 124578 Then
'ô 147 Eelse
Public Function Conditional(mask)
On Error GoTo Errors
Dim condition As String
Dim orignalcondition As String
Dim truecondition As Boolean
Dim properdies As String
'test to make shure mask contanes conditions
If InStr(mask, "[") = 0 Then
If Left(mask, 2) = "E("
Then
mask =
Right(mask, Len(mask) - 2)
mask =
Left(mask, Len(mask) - 1)
End If
GoTo bottom
End If
Do
'check if or exists
If Right(Left(mask, InStr(mask,
"]") + 1), 1) = "O" Then
GoTo Findo
End If
Do
'find
condition
condition =
Right(mask, Len(mask) - InStr(mask, "["))
condition =
Left(condition, InStr(condition, "]") - 1)
orignalcondition = "D[" & condition & "]"
'check if
condition is true
Call
testcondition(condition, truecondition)
If condition
= "ERROR" Or condition ="CSError" Then
GoTo Errors
End If
If
truecondition = True Then
If Left(Right(mask, Len(mask) - Len(orignalcondition)), 1) = "T" Or
Left(Right(mask,Len(mask) - Len(orignalcondition)), 1) = "A" Then
If Left(Right(mask, Len(mask) - Len(orignalcondition)), 1) = "T" Then
'This is the right properdy
properdies = Right(mask,Len(mask) - InStr(mask, "T") - 1)
properdies = Left(properdies, InStr(properdies, ")") - 1)
mask = properdies
GoTo bottom
Else
'Do things to reset mask
mask = Right(mask, Len(mask) - Len(condition) - 3)
GoTo EndLoop1
End If
Else
If InStr(InStr(orignalcondition,"[") + 1, orignalcondition,
"[") = 0 Then
If Left(Right(mask, Len(mask)- Len(condition) - 3), 1) <> "O"
Then
GoTo Errors
Else
'remove privous statment
'mask = Right(mask,Len(mask) - InStr(2, mask, "I") + 1)
GoTo Findo
End If
Else
GoTo Errors
End If
End If
Else
If Left(Right(mask, Len(mask) -Len(condition) - 3), 1) = "O" Then
GoTo Findo
Else
GoTo FindEOrSecondI
End If
End If
EndLoop1:
Loop
Findo:
Do
'find
condition
condition =
Right(mask, Len(mask) -InStr(mask, "["))
condition =
Left(condition,InStr(condition, "]") - 1)
orignalcondition = orignalcondition & "D["& condition &
"]"
'check if
condition is true
Call
testcondition(condition,truecondition)
If condition
= "ERROR" Or condition ="CSError" Then
GoTo Errors
End If
If
Left(Right(mask, Len(mask) - Len(condition) - 3), 1) = "T" Or
Left(Right(mask, Len(mask) - Len(condition) - 3), 1) = "O" Then
If truecondition = True Then
'This is the right properdy
properdies = Right(mask, Len(mask) - InStr(mask, "T") - 1)
properdies = Left(properdies, InStr(properdies, ")") - 1)
mask = properdies
GoTo bottom
End If
If Left(Right(mask, Len(mask) - Len(condition) - 3), 1) = "T" Then
GoTo FindEOrSecondI
End If
If truecondition = False Then
'Do things to reset mask
mask = Right(mask, Len(mask) - Len(condition) - 3)
GoTo EndLoop2
End If
Else
GoTo Errors
End If
EndLoop2:
Loop
FindEOrSecondI:
'check if next statement exists
If InStr(2, mask, "I") = 0
Then
GoTo FindE
End If
'remove privous statment
mask = Right(mask, Len(mask) -
InStr(2, mask, "I") + 1)
Loop
FindE:
'find else
mask = Right(mask, Len(mask) - InStr(mask, "E") -
1)
mask = Left(mask, Len(mask) - 1)
GoTo bottom
Errors:
If mask = "CDError" Then
'an error has occurred in the
testcondition
sub
Else
'another form of an error has
occurred,
probably related to the syntax of the mask
End If
Exit Function
bottom:
Conditional = mask
End Function
Public Sub testcondition(condition, truecondition)
Dim comparison As String
Dim properdy1 As String
Dim properdy2 As String
Dim colem As String
Dim operition As String
Dim L As String
Dim l2 As Double
Dim R As String
Dim r2 As Double
Dim oringanall As String
Dim oringanalr As String
'replace colems with content
Do Until InStr(condition, "{") = 0
'find colem code
colem = Right(condition,
Len(condition) - InStr(condition, "{"))
colem = Left(colem, 2)
'find comlem content
findcolcontents colem
'replece code with content
L = Left(condition, InStr(condition,
"{") - 1)
R = Right(condition, Len(condition) -
InStr(condition, "}"))
condition = L & colem & R
Loop
'set condition to varabules
properdy1 = Left(condition, InStr(condition, " ") -
1)
properdy2 = Right(condition, Len(condition) -
InStr(Len(properdy1) + 2, condition, " "))
'find comparison simbel
comparison = Right(condition, Len(condition) -
InStr(condition, " "))
comparison = Left(comparison, InStr(comparison, "")
- 1)
'remove "$"
If Left(properdy1, 1) = "$" Then properdy1 =
Right(properdy1, Len(properdy1) - 1)
If Left(properdy2, 1) = "$" Then properdy2 =
Right(properdy2, Len(properdy2) - 1)
'add subtract multiply and devide
Do Until InStr(properdy1, "_") = 0
'find operition
oprtition =
Left(Right(properdy1,Len(properdy1) - InStr(properdy1, "_")), 1)
'find numbers to operate
L = Left(properdy1, InStr(properdy1,
"_") - 1)
R = Right(properdy1, Len(properdy1)
-InStr(properdy1, "_") - 2)
If InStr(R, "_") <> 0
Then
R = Left(R,
InStr(R, "_") - 1)
End If
'check to mack shure numbers are
nummaric
oringanall = L
oringanalr = R
If Not IsNumeric(L) Or Not
IsNumeric(R) Then
If LCase(L) =
"error" Or LCase(R) ="error" Then
condition = "CSError"
Exit Sub
End If
If L =
"" Or R = "" Then
If L = "" Then
L = 0
End If
If R = "" Then
R = 0
End If
End If
L = Trim(L)
R = Trim(R)
If Not
IsNumeric(L) Or Not IsNumeric(R)
Then
GoTo Errors
End If
End If
l2 = L
r2 = R
'oterate
Select Case oprtition
Case "+"
l2 = l2 + r2
Case "-"
l2 = l2 - r2
Case "*"
l2 = l2 * r2
Case "/"
l2 = l2 / r2
Case "\"
l2 = l2 \ r2
Case "^"
l2 = l2 ^ r2
Case Else
GoTo Errors
End Select
properdy1 = l2 &
Right(properdy1,Len(properdy1) - Len(oringanall) - Len(oringanalr) -3)
Loop
Do Until InStr(properdy2, "_") = 0
'find operition
oprtition =
Left(Right(properdy2,Len(properdy2) - InStr(properdy2, "_")), 1)
'find numbers to operate
L = Left(properdy2, InStr(properdy2,
"_") - 1)
R = Right(properdy2, Len(properdy2) -
InStr(properdy2, "_") - 2)
If InStr(R, "_") <> 0
Then
R = Left(R,
InStr(R, "_") - 1)
End If
'check to mack shure numbers are
nummaric
oringanall = L
oringanalr = R
If Not IsNumeric(L) Or Not
IsNumeric(R) Then
If LCase(L) =
"error" Or LCase(R) = "error" Then
condition = "CSError"
Exit Sub
End If
If L =
"" Or R = "" Then
If L = "" Then
L = 0
End If
If R = "" Then
R = 0
End If
End If
L = Trim(L)
R = Trim(R)
If Not
IsNumeric(L) Or Not IsNumeric(R)
Then
GoTo Errors
End If
End If
l2 = L
r2 = R
'oterate
Select Case oprtition
Case "+"
l2 = l2 + r2
Case "-"
l2 = l2 - r2
Case "*"
l2 = l2 * r2
Case "/"
l2 = l2 / r2
Case "\"
l2 = l2 \ r2
Case "^"
l2 = l2 ^ r2
Case Else
GoTo Errors
End Select
properdy2 = l2 & Right(properdy2,
Len(properdy2) - Len(oringanall) - Len(oringanalr) - 3)
Loop
'check if condition is true
Select Case comparison
Case "="
If properdy1 = properdy2 Then
truecondition
= True
Else
truecondition
= False
End If
Case "<>"
If properdy1 <> properdy2 Then
truecondition
= True
Else
truecondition
= False
End If
Case "<"
If Not IsNumeric(properdy1) Or Not
IsNumeric(properdy2) Then
If
LCase(properdy1) = "error" Or LCase(properdy2) = "error"
Then
condition = "CSError"
Exit Sub
End If
If properdy1
= "" Then
properdy1 = 0
End If
If properdy2
= "" Then
properdy2 = 0
End If
properdy1 =
Trim(properdy1)
properdy2 =
Trim(properdy2)
If Not
IsNumeric(properdy1) Or Not IsNumeric(properdy2) Then
condition = "CSError"
Exit Sub
End If
End If
If CDbl(properdy1) <
CDbl(properdy2) Then
truecondition
= True
Else
truecondition
= False
End If
Case ">"
If Not IsNumeric(properdy1) Or Not
IsNumeric(properdy2) Then
If
LCase(properdy1) = "error" Or LCase(properdy2) = "error"
Then
condition = "CSError"
Exit Sub
End If
If properdy1
= "" Then
properdy1 = 0
End If
If properdy2
= "" Then
properdy2 = 0
End If
properdy1 =
Trim(properdy1)
properdy2 =
Trim(properdy2)
If Not
IsNumeric(properdy1) Or Not IsNumeric(properdy2) Then
condition = "CSError"
Exit Sub
End If
End If
If CDbl(properdy1) >
CDbl(properdy2) Then
truecondition
= True
Else
truecondition
= False
End If
Case ">="
If Not IsNumeric(properdy1) Or Not
IsNumeric(properdy2) Then
If
LCase(properdy1) = "error" Or LCase(properdy2) = "error"
Then
condition = "CSError"
Exit Sub
End If
If properdy1
= "" Then
properdy1 = 0
End If
If properdy2
= "" Then
properdy2 = 0
End If
properdy1 =
Trim(properdy1)
properdy2 =
Trim(properdy2)
If Not
IsNumeric(properdy1) Or Not IsNumeric(properdy2) Then
condition = "CSError"
Exit Sub
End If
End If
If CDbl(properdy1) >=
CDbl(properdy2) Then
truecondition
= True
Else
truecondition
= False
End If
Case "<="
If Not IsNumeric(properdy1) Or Not
IsNumeric(properdy2) Then
If
LCase(properdy1) = "error" Or LCase(properdy2) = "error"
Then
condition = "CSError"
Exit Sub
End If
If properdy1
= "" Then
properdy1 = 0
End If
If properdy2
= "" Then
properdy2 = 0
End If
properdy1 =
Trim(properdy1)
properdy2 =
Trim(properdy2)
If Not
IsNumeric(properdy1) Or Not IsNumeric(properdy2) Then
condition = "CSError"
Exit Sub
End If
End If
If CDbl(properdy1) <=
CDbl(properdy2) Then
truecondition
= True
Else
truecondition
= False
End If
Case Else
GoTo Errors
End Select
Exit Sub
Errors:
condition = "ERROR"
End Sub
Public Sub findcolcontents(Data)
'place your own code here...
End Sub
I am as a web developer for a small company, working for a small company. I work on banking websites and verious related projects.
Comments