Public Function FindCompleteWordInString(SearchStr As Variant, MatchStr As Variant, Optional Start As Long) As Long
'....................................................................
' Author: HalloweenWeed
' Date: 2/4/2020
' Looks for a match inside a string of characters, only returns positive
' Long integer if the match is a full word inside the string.
' Optional Start As Long sets the first character to start the search at,
' if not used then the search starts at the beginning;
' otherwise if less than 1 or more than the length of SearchStr
' search begins at the first character in SearchStr.
' Positive Long integer returned is the Index of
' the first whole word match found within SearchStr.
' MatchStr is the string looked for, inside SearchStr.
' If an alphanumeric character is immediately on either side of
' the match word, then it is ignored (thus only whole-word matches).
' The match word must match a portion of the string exactly except case is ignored.
' Leading and trailing punctuation in the string to be searched is ignored.
' Also works if the match term is at the very beginning or end of the string.
' If either string is Null or zero-length then -1 is returned.
' Limitation: SearchStr must be < 2,147,483,648 characters in length.
'....................................................................
'On Error GoTo Err_Handler
Dim Index As Variant, PrevIndex As Variant
Dim LeadChrUsed As Boolean, TrailChrUsed As Boolean
Dim WordFound As Boolean
Dim LeadChr As String, TrailChr As String
Dim StrLen As Long
StrLen = 0
Index = 0
LeadChr = vbNullString
TrailChr = vbNullString
WordFound = False
LeadChrUsed = False
TrailChrUsed = False
If IsMissing(Start) Then
PrevIndex = 1
Else
If Start < 1 Or Start > Len(SearchStr) Then
PrevIndex = 1
Else
PrevIndex = Start
End If
End If
FindCompleteWordInString = -1 'default
If VarType(SearchStr) <> vbString Then GoTo ExitFunction
If VarType(MatchStr) <> vbString Then GoTo ExitFunction
If Len(SearchStr) < 1 Then GoTo ExitFunction
If Len(MatchStr) < 1 Then GoTo ExitFunction
StrLen = Len(MatchStr)
Do While Index < Len(SearchStr) And PrevIndex < Len(SearchStr) And Not WordFound
Index = InStr(PrevIndex, SearchStr, MatchStr, vbTextCompare)
If Not IsNull(Index) Then
If Index > 0 Then 'if we have a possible match then check it
If Index > 1 Then 'if match is on the very left side of string,
'then no lead character is applicable
LeadChr = Mid(SearchStr, Index - 1, 1)
LeadChrCint = Asc(LeadChr)
LeadChrUsed = True
Else
LeadChr = vbNullString
LeadChrCint = 0
LeadChrUsed = False
End If
If Index < Len(SearchStr) - StrLen Then 'if match is on the very right side
'of string, then no trailing character is applicable
TrailChr = Mid(SearchStr, Index + StrLen, 1)
TrailChrCint = Asc(TrailChr)
TrailChrUsed = True
Else
TrailChr = vbNullString
TrailChrCint = 0
TrailChrUsed = False
End If
'look for letters that indicate word embedded inside another word
If LeadChrUsed Then
If LeadChrCint < 65 Or (LeadChrCint > 90 And LeadChrCint < 97) Or _
LeadChrCint > 122 Then
LeadChrUsed = False
End If
End If
If TrailChrUsed Then
If TrailChrCint < 65 Or (TrailChrCint > 90 And TrailChrCint < 97) Or _
TrailChrCint > 122 Then
TrailChrUsed = False
End If
End If
'if no alphanumeric lead or trailing character found, then we matched full word
If (Not LeadChrUsed) And (Not TrailChrUsed) Then
'found complete independant word match
WordFound = True
Exit Do
End If
Else
Exit Do
End If
Else
Exit Do
End If
If WordFound Then Exit Do
If Index > Len(SearchStr) Then Exit Do
PrevIndex = Index + StrLen 'start the next loop searching after the aborted find
Index = 0
LeadChrUsed = False
TrailChrUsed = False
LeadChr = vbNullString
TrailChr = vbNullString
LeadChrCint = 0
TrailChrCint = 0
Loop
If Not WordFound Then Index = 0
FindCompleteWordInString = Index 'match found here (if not zero)
ExitFunction:
Exit Function
Err_Handler:
MsgBox ("Error #" & Err.Number & ": " & Err.Description)
Resume ExitFunction
End Function
