ReplaceWordEx – Replace whole words, with your choice of delimiters

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 callerEnum 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 lettersEnd 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 [email protected]' 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 = CountEnd 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 ReplaceWordExPrivate 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

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: