Binaryworld - ReplaceWordEx - Replace whole words, with your choice of delimiters ... [ VB -> String ]

Option Explicit

'------------------------------------------------------------------------
' 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

' Replace a whole word
'
' Based on ReplaceWord function from VB2TheMax - www.vb2themax.com
'
' Changes from VB2TheMax function were made to allow specification of
' what constitutes a separator between words
'
'---------------------------------------------------------------------------
'Contact Peter at stubbsy@hunterlink.net.au
' http://users.hunterlink.net.au/~dgps
'---------------------------------------------------------------------------
'
' Choices for separator are as described above for the sepType enum
'

Function ReplaceWordEx(Source As String, Find As String, ReplaceStr As String, _
  Optional ByVal Start As Long = 1, Optional Count As Long = -1, _
  Optional Compare As VbCompareMethod = vbBinaryCompare, _
  Optional separatorType As sepType = spacesSymbolsCtrlAndDigits, _
  Optional Separator As String = vbNullString) As String
  Dim findLen As Long
  Dim replaceLen As Long
  Dim index As Long
  Dim counter As Long
  Dim charcode As Integer
  Dim replaceIt As Boolean

  findLen = Len(Find)
  replaceLen = Len(ReplaceStr)

  ' this prevents an endless loop
  If findLen = 0 Then Err.Raise 5

  If Start < 1 Then Start = 1
  index = Start

  ' let's start by assigning the source to the result
  ReplaceWordEx = Source

  Do
    index = InStr(index, ReplaceWordEx, Find, Compare)
    If index = 0 Then Exit Do

    replaceIt = False
    ' check that it is preceded by a punctuation symbol
    If index > 1 Then
      charcode = Asc(UCase$(Mid$(ReplaceWordEx, 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$(ReplaceWordEx, index + Len(Find), _
        1)) & " ")
      If IsValidChar(charcode, separatorType, Separator) Then
        ' do the replacement
        ReplaceWordEx = Left$(ReplaceWordEx, index - 1) & ReplaceStr & _
          Mid$(ReplaceWordEx, index + findLen)
        ' skip over the string just added
        index = index + replaceLen
        ' increment the replacement counter
        counter = counter + 1
      End If
    Else
      ' skip over this false match
      index = index + findLen
    End If

    ' Note that the Loop Until test will always fail if Count = -1
  Loop Until counter = Count

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