View Single Post
  #2   Report Post  
BizMark BizMark is offline
Member
 
Location: London
Posts: 78
Default

Public AndOp(0 To 255) As Integer
'To remember the value of the Status flag during 'Find' operations, when parentheses are used. <<
Public FlagPos As Integer

Static Function TextMatchesPattern(tText, ByVal tPattern, Optional ByRef tWhatMatched As String)
'Compare text using a pattern in &#() format
'Return boolean True/False depending on whether the text matches the criteria
'NEW MAY-06: Return the phrases that made the match TRUE into the variable passed to tWhatMatched.

Dim otWhatMatched As String

If TypeName(tText) = "Range" Then
tText = tText.Text
End If

If tPattern &lt;&gt; LastErrorString Then
ExprErrorGiven = False
End If
If Right(tPattern, 1) &lt;&gt; " " Then
tPattern = tPattern & " "
End If

posSPACE = InStr(1, tPattern, " ")
posBRACE1 = InStr(1, tPattern, "[")
posBRACE2 = InStr(1, tPattern, "]")
While posBRACE2 &gt; posSPACE And Not (posBRACE1 &gt; posSPACE)
posSPACE = InStr(posBRACE2, tPattern, " ")
posBRACE1 = InStr(1, tPattern, "[")
posBRACE2 = InStr(1, tPattern, "]")
Wend

If Left(tPattern, 1) &lt;&gt; "#" Then
cStatus = False
Else
'If the pattern starts with a # character, take the rest of the string to mean
' "everything except..." .
cStatus = True
End If

oPattern = tPattern
FlagPos = 0
LastOp = 0 '1=And (&) 2=Not (#) last operand before bracket
Q = 0
AndOp(0) = 0 'Do an OR when cascading back to root paranthesis level
NewStatus = False 'Trial

While posSPACE &gt; 0
tPhrase = Left(tPattern, posSPACE - 1)

prebracketWhatMatched = otWhatMatched

If Mid(tPhrase, 2, 1) = "(" Then
'parentheses used to mark a part of the find criteria which will generate its own status
'so phrase must contain what came before AND any selection of what appears in the brackets
FlagPos = FlagPos + 1
FlagStack(FlagPos) = cStatus
If (Left(tPhrase, 1) = "&") Then
AndOp(FlagPos) = 1
Else
AndOp(FlagPos) = 2
End If
tPhrase = Mid(tPhrase, 3)
cStatus = False 'start decision making again within brackets
End If
If Left(tPhrase, 1) = "(" Then
'bracket without & or # - do an OR with the result of the bracketed expression and the rest
FlagPos = FlagPos + 1
FlagStack(FlagPos) = cStatus
AndOp(FlagPos) = 0 'no AND/NOT operand
tPhrase = Mid(tPhrase, 2)
cStatus = False 'start decision making again within brackets
End If
While Right(tPhrase, 1) = ")"
Q = Q + 1 'do close-off routine after checking text
tPhrase = Left(tPhrase, Len(tPhrase) - 1)
Wend

nBracePos = 1
If InStr(1, "#&(", Left(tPhrase, 1), 1) &gt; 0 Then
nBracePos = 2
End If
'Replace [ with a leading space and ] with a closing space
'so that [word] can be used to indicate 'find entire word'
If Mid(tPhrase, nBracePos, 1) = "[" Then
tPhrase = Left(tPhrase, nBracePos - 1) & " " & Mid(tPhrase, nBracePos + 1)
tText = " " & tText
End If
If Right(tPhrase, 1) = "]" Then
tPhrase = Left(tPhrase, Len(tPhrase) - 1) & " "
tText = tText & " "
End If

'For AND word
If Left(tPhrase, 1) = "&" Then
If InStr(1, tText, Mid(tPhrase, 2), 1) = 0 Then
cStatus = False
'otWhatMatched = ""
Else
'otWhatMatched = otWhatMatched & tPhrase & " "
End If
End If

'For NOT word
If Left(tPhrase, 1) = "#" Then
If InStr(1, tText, Mid(tPhrase, 2), 1) &lt;&gt; 0 Then
cStatus = False
'otWhatMatched = ""
Else
'otWhatMatched = otWhatMatched & tPhrase & " "
End If
End If

'For OR word
If InStr(1, tText, tPhrase, 1) &lt;&gt; 0 Then
If Not cStatus Then
cStatus = True
'otWhatMatched = otWhatMatched & tPhrase & " "
End If
End If

If cStatus Then
If Not ocStatus Then
otWhatMatched = otWhatMatched & tPhrase & " "
End If
Else
otWhatMatched = ""
End If
ocStatus = cStatus

While Q &gt; 0 'if closing off brackets, apply new status to previous one in stack
'close the bracketed section
NewStatus = cStatus 'The new status to apply to the one that was stored at the ( point

'check that stack hasn't been read past empty by too many close-brackets
If FlagPos &lt; 0 Then
If Not ExprErrorGiven Then
Beep
MsgBox ("There are too many close-brackets in your expression. Please try again."), vbExclamation
LastErrorString = oPattern
ExprErrorGiven = True
End If
Exit Function
End If

'Now get the last status
cStatus = FlagStack(FlagPos)
If AndOp(FlagPos) = 1 Then
cStatus = cStatus And NewStatus
Else
If AndOp(FlagPos) = 2 Then
cStatus = cStatus And (Not NewStatus)
Else
cStatus = cStatus Or NewStatus
End If
End If

If FlagPos &gt;= 0 Then
FlagPos = FlagPos - 1
End If
Q = Q - 1

'If Q = 0 And cStatus And otWhatMatched = "" Then
'otWhatMatched = prebracketWhatMatched
'End If
Wend



tPattern = Mid(tPattern, posSPACE + 1)
posSPACE = InStr(1, tPattern, " ")
posBRACE1 = InStr(1, tPattern, "[")
posBRACE2 = InStr(1, tPattern, "]")
While posBRACE2 &gt; posSPACE And Not (posBRACE1 &gt; posSPACE)
posSPACE = InStr(posBRACE2, tPattern, " ")
posBRACE1 = InStr(1, tPattern, "[")
posBRACE2 = InStr(1, tPattern, "]")
Wend
Wend
tPattern = oPattern
ExprErrorGiven = False
TextMatchesPattern = cStatus

If Not IsMissing(tWhatMatched) Then
tWhatMatched = otWhatMatched
End If
End Function

Last edited by BizMark : November 17th 06 at 07:28 PM