VBA: Find and Replace Exact Match Words

[delonte]

After extensive research I finally found a VBS code to find and replace words in paragraphs only if its an exact match. The only problem I have is that the code only replaces a certain word only once in a specific cell.

So columns A through C have a bunch of paragraphs of text. Using this macro, it automatically scans all the words in column D and if it finds those words anywhere in columns A through C, it will replace it with the word next to it on column E. So if the sentence is "Hello how is hell hell?" in column A. And in column D there is a word hell - then the code below doesn't replace "hello" at all (working as intended), it does replace the first "hell" in the sentence (working as intended), but does not replace the second "hell" (not working as intended).

Anyone have any idea how to tweak the code so all words get replaced, and not just the first instance?

The code:

Sub exa()Dim _
rngLookFor          As Range, _
rngDataCell         As Range, _
strFormula          As String
    
    For Each rngLookFor In Range("D1:D99")
        For Each rngDataCell In Range("A1:C99")
            
            strFormula = rngDataCell.Text
            If ReturnReplacement(rngLookFor.Text, rngLookFor.Offset(, 1).Text, strFormula) Then
                rngDataCell.Value = strFormula
            End If
        Next
    Next
End Sub
    
Function ReturnReplacement(LookFor As String, _
                           ReplaceWith As String, _
                           FormulaString As String _
                           ) As Boolean
Static REX As Object '<--- RegExp
    
    If REX Is Nothing Then
        Set REX = CreateObject("VBScript.RegExp")
        REX.Global = False
        REX.IgnoreCase = True
    End If
    
    With REX
        .Pattern = "\b" & LookFor & "\b"
        
        If .Test(FormulaString) Then
            FormulaString = .replace(FormulaString, ReplaceWith)
            ReturnReplacement = True
        End If
    End With
End Function

Code above found from second to last post in: http://www.mrexcel.com/forum/excel-questions/468331-find-replace-exact-only-2.html

 

[Alan in NJ]

hanks for the very quick reply, Rick.

I am not sure what the protocol is when visiting multiple forums. Rather than bother you to write code from scratch, perhaps I should try to get help enhancing some terrific code that was written for me last summer on the VBAExpress forum. It searches each cell (~ 20,000 rows) in Column A on Sheet 1 for each word (or phrase) in Column 1 of sheet 2: ("Replacements") and if one or more are found, it inserts a corresponding word from Column 2 of "Replacements" into one or more empty cells in in the same row in sheet 1. In other words, "replacements" is a misnomer; it doesn't replace anything in Sheet 1 Column A , rather it populates one or more empty cells to the right of Sheet1, Col. A if the words/phrases from the "replacements" table are found. If I put the same word/phrase in both columns of the replacements table, it simply finds and inserts that word/phrase to the right of the text column. But it does not highlight the original word/phrase which is what I now need.

If a tweek to your code is trivial, the answer to your questions are as mentioned above: text to be searched Sheet1 Column A (all text is black, uppercase); words/phrases sought are in sheet "Replacements" column A; all found text to be changed to one color (color to be selected in the code or a message box so search can be run a second time with a different list resulting in a different color).

Thanks again,

Alan