Binaryworld - InstrWordEx - Find a whole word, with your choice of delimiters ... [ VB -> String ]

'------------------------------------------------------------------------
' This enum is used by both InstrWordEx and ReplaceWordEx
'
' It uses a binary value to determine what separator characters are allowed
' bit 0 = allow spaces
' bit 1 = allow symbols
' bit 2 = allow control chars
' bit 3 = allow digits
' If all are excluded (ie a value of 0) then this means char must match a
' special separator provided by caller

Enum sepType
  specialSep = 0         'binary 0000 = words are ONLY separated by
                  ' a specified separator
  spacesOnly = 1         'binary 0001 = words must be separated By
                  ' spaces
  spacesAndSymbols = 3      'binary 0011 = words must be separated By
                  ' spaces Or symbols
  spacesSymbolsAndCtrl = 7    'binary 0111 = words are separated by
                  ' spaces, symbols or ctrl chars
  spacesSymbolsCtrlAndDigits = 15 'binary 1111 = words are separated by
                  ' anything but letters
End Enum

' Choices for separator are as described above for the sepType enum
'
' Examples:
' pos = InstrWordEx(1,"This is a string","is",vbTextCompare)
' returns 6 in pos since there is a word "is" preceded and followed by a Space
'
' pos = InstrWordEx(1,"This-is-a-string","is",vbTextCompare)
' returns 6 in pos since there is a word "is" preceded and followed by a symbol
'
' pos = InstrWordEx(1,"This-is-a-string","is",vbTextCompare,spacesOnly)
' returns 0 in pos since there are no occurences of "is" preceded and
' followed by a space
'
' pos = InstrWordEx(1,"This is a list of 310 things","31",vbTextCompare)
' returns 19 in pos since the digits 31 are preceded by a space and followed
' by a digit
' which is, by default, considered a valid separator
'
' pos = InstrWordEx(1,"This is a list of 310
' things","31",vbTextCompare,spacesAndSymbols)
' returns 0 in pos since this specifies spaces and symbols (but not digits)
' are valid separators
'
' pos = InstrWordEx(1,"This/is/a/string","is",vbTextCompare,specialSep,"/")
' returns 6 in pos since the word "is" is both preceded and followed by /
'
Function InstrWordEx(Start As Long, Source As String, Find As String, _
  compareMethod As VbCompareMethod, Optional separatorType As sepType = _
  spacesSymbolsCtrlAndDigits, Optional Separator As String = vbNullString) As _
  Long
  Dim index As Long
  Dim charcode As Integer
  Dim separatorInvalid As Boolean

  ' assume the search fails
  InstrWordEx = 0

  index = Start - 1

  Do
    ' search the next occurrence, exit if not found
    index = InStr(index + 1, Source, Find, compareMethod)
    If index = 0 Then Exit Function

    If index > 1 Then
      charcode = Asc(UCase$(Mid$(Source, index - 1, 1)))
    Else
      charcode = 32
    End If

    ' check that it is preceded by a valid separator
    If IsValidChar(charcode, separatorType, Separator) Then
      ' check that it is followed by a valid separator
      charcode = Asc(UCase$(Mid$(Source, index + Len(Find), 1)) & " ")
      If IsValidChar(charcode, separatorType, Separator) Then
        InstrWordEx = index
        Exit Function
      End If
    End If
  Loop

End Function

'This function determines if the character value in char is an acceptable
' separator of the
'type specified by separatorType

'The function is used by both InstrWordEx and ReplaceWordEx

Private Function IsValidChar(char As Integer, separatorType As sepType, _
  Separator As String)
  Dim charType As Integer

  'Ctrl are chars in charType 0-31
  'Spaces and symbols are chars in charType 32-47, 58-64 and 91-255
  'Digits are chars in charType 48-57

  If separatorType = specialSep Then
    IsValidChar = (char = Asc(UCase$(Separator)))
    Exit Function
  End If

  'Determine charType that char falls in
  Select Case char
     Case Is < 32 '0-32 = ctrl
      charType = 4 '0100 binary

     Case 32 'space
      charType = 1 '0001 binary

     Case Is < 48, Is > 90 '32-48 or 91-255 = symbols (first range)
      charType = 2 '0010 binary

     Case Is < 58 '48-57 = digits
      charType = 8 '1000 binary

     Case Is < 65 '58-64 = symbols (second range)
      charType = 2 '0010 binary

    Case Else 'it's a letter
      charType = 0 '0000 binary
  End Select

  IsValidChar = Not ((charType And separatorType) = 0)
End Function