Re: Find words within range of other word in string?????????

Larry,

The code you send me doesn't work for memofields.

Private Function Proximity(ByVal text As String, Range As Long, _
ByVal Words As Variant) As Boolean
' Returns True if any word in 'Words' is within 'Range' words of
' any other word in 'Words'.
Dim pos&, idx&, cnt&, itm
Dim test As String
Dim match As Collection
Dim found As Collection
Dim list As Collection

Set match = New Collection
Set found = New Collection
Set list = New Collection

' Buffer the last word
text = text & " "

' Build look-up table
On Error Resume Next
For Each itm In Words
match.Add 1, itm
Next

On Error GoTo Skip

For idx = 1 To Len(text)
' Find words
Select Case Mid$(text, idx, 1)
Case "a" To "z", "A" To "Z"
If pos = 0 Then pos = idx
Case Else
If pos > 0 Then
' Got a word
test = Mid$(text, pos, idx - pos)
cnt = cnt + 1
' Look it up (will error (to Skip:) if no match found)
If match(test) > 0 Then
' Store word & count on match
list.Add test
found.Add cnt
End If
Skip:
If Err.number Then Resume Skipped
Skipped:
pos = 0
End If
End Select
Next

' Check ranges
For idx = 1 To found.Count - 1
' Check range
If (found(idx + 1) - found(idx)) <= Range Then
' Reject words next to themselves
If list(idx + 1) <> list(idx) Then
Proximity = True
Exit Function
End If
End If
Next

End Function

Marco
Larry Serflaten schreef:

"Larry Serflaten" <serflaten@xxxxxxxxxxxxxx> wrote

As is, it only returns true if any two words are near each other:

That should read .. if any two (or more) words are near ....

LFS

.

Relevant Pages