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

 

[JoeMo]

I confirm this indeed replaces phrases and it replaces multiple instances but it is not exact match. For example in column D I put 'he' 'hel' and 'hello'- then if the word "hello" shows up in columns A:C, it would only replace the 'he' part if that is higher up listed in the D column.

Please provide an example of your sheet. The code I posted in post # 8 is for phrases not single words.

Also if in column D I only want to replace the word "hell" it would change the first four letters of the world "hello" if present in columns A:C.

Please use the code I posted in post #2 if you are replacing a single word - that's what you requested in your original post.

 

[Rick Rothstein]

I confirm this indeed replaces phrases and it replaces multiple instances but it is not exact match. For example in column D I put 'he' 'hel' and 'hello'- then if the word "hello" shows up in columns A:C, it would only replace the 'he' part if that is higher up listed in the D column.

Your thread title says "VBA: Find and Replace Exact Match Words" which says to me "whole, stand-alone" words. The part of your message above that I bolded seems to indicate you are trying to replace parts of words, not whole words. Which is it... whole words or parts of words?

 

[delonte]

Sorry if I haven't been able to make myself clear. I want to replace words AND phrases. The column D in question might have one word, two words, or maybe even a long sentence. Column A-C will have loads of text. So I want the word or phrases in column D that are found in columns A-C to be replaced (with whatever is in the neighboring column E).

Eg:
Cell A1 can have the following sentence: "Hello all my name is John and I like sports. Hello."

Cell D1 has the word "Hell"
Cell D2 has the word "Hello"
Cell D3 has the world "my name"
Cell E1 has the number "1"
Cell E2 has the number "2"
Cell E3 has the number "3"


So when the macro runs Cell A1 should change to "2 all 3 is John and I like sports. 2".

The problem was that the first code that was given did not work for phrases like "my name" - this was my fault because I did not mention I also needed phrases and not just words.

Then the second code I tried replaced words and phrases but unfortunately the replace type was not for an exact word or exact phrase, but a partial match (like if the word 'hell' was to be replaced, it incorrectly replaced a large word that contained the letters 'hell': like 'hello'. The word 'hell' should only replace the word 'hell' not the word 'hello'. Same principle should apply to phrases.).

The initial code I posted did what I want except If cell A1 had multiple instances of the word "hello" it only replaced it the first time it saw it and ignored the second 'hello' in there.

Perhaps what I'm asking is outside the capability of VBA, if so then I apologize.

 

[Rick Rothstein]

Eg:
Cell A1 can have the following sentence: "Hello all my name is John and I like sports. Hello."

Cell D1 has the word "Hell"
Cell D2 has the word "Hello"
Cell D3 has the world "my name"
Cell E1 has the number "1"
Cell E2 has the number "2"
Cell E3 has the number "3"

So when the macro runs Cell A1 should change to "2 all 3 is John and I like sports. 2".

When I run the code that I posted in Message #9 against that set up, It changes cell A1 to read exactly what you posted you wanted it changed to. Did you try that code? I may have put you off when I mentioned "stand-alone words", but it works for phrases too; however, when you include phrases, you cannot put any of the words appearing in your phrases as stand-alone words earlier in the list than the phrase itself or those stand-alone words will be replaced first and the phrase won't exist anymore by the time you get to it... same holds true for smaller phrases that may be part of a different larger phrase... the larger phrase must appear first.

 

[Rick Rothstein]

...however, when you include phrases, you cannot put any of the words appearing in your phrases as stand-alone words earlier in the list than the phrase itself or those stand-alone words will be replaced first and the phrase won't exist anymore by the time you get to it... same holds true for smaller phrases that may be part of a different larger phrase... the larger phrase must appear first.

The following code handles stand-alone words and multi-word phases PLUS it will work no matter what order the words and phrases in Column D are in (just write your list and their replacements in any order and the code will take care of making sure smaller included words or phrases to not get replaced before larger ones that contain them...

Sub delonteReplace3()
  Dim X As Long, LastRow As Long, C As Range, Cel As Range, S As Variant
  Application.ScreenUpdating = False
  LastRow = Cells(Rows.Count, "D").End(xlUp).Row
  For X = 1 To LastRow
    Cells(X, "F").Value = X
    Cells(X, "G").Value = UBound(Split(Cells(X, "D").Value))
    Cells(X, "H").Value = Len(Cells(X, "D").Value)
  Next
  
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("G1:G" & LastRow), _
      SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  ActiveSheet.Sort.SortFields.Add Key:=Range("H1:H" & LastRow), _
      SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
      .SetRange Range("D1:H" & LastRow)
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
  
  For Each C In Range("D1:D" & LastRow)
    For Each Cel In Intersect(ActiveSheet.UsedRange, Columns("A:C"))
      For X = Len(Cel) - Len(C) + 1 To 1 Step -1
        If Mid(" " & Cel & " ", X, Len(C) + 2) Like "[!0-9A-Za-z]" & C & "[!0-9A-Za-z]" Then
          Cel = Replace(Cel, C.Value, C.Offset(, 1).Value)
        End If
      Next
    Next
  Next
  
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("F1:F" & LastRow), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
      .SetRange Range("D1:H" & LastRow)
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
  Columns("F:H").Delete
  
  Application.ScreenUpdating = True
End Sub

 

[delonte]

The following code handles stand-alone words and multi-word phases PLUS it will work no matter what order the words and phrases in Column D are in (just write your list and their replacements in any order and the code will take care of making sure smaller included words or phrases to not get replaced before larger ones that contain them...

Sub delonteReplace3()
  Dim X As Long, LastRow As Long, C As Range, Cel As Range, S As Variant
  Application.ScreenUpdating = False
  LastRow = Cells(Rows.Count, "D").End(xlUp).Row
  For X = 1 To LastRow
    Cells(X, "F").Value = X
    Cells(X, "G").Value = UBound(Split(Cells(X, "D").Value))
    Cells(X, "H").Value = Len(Cells(X, "D").Value)
  Next
  
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("G1:G" & LastRow), _
      SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  ActiveSheet.Sort.SortFields.Add Key:=Range("H1:H" & LastRow), _
      SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
      .SetRange Range("D1:H" & LastRow)
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
  
  For Each C In Range("D1:D" & LastRow)
    For Each Cel In Intersect(ActiveSheet.UsedRange, Columns("A:C"))
      For X = Len(Cel) - Len(C) + 1 To 1 Step -1
        If Mid(" " & Cel & " ", X, Len(C) + 2) Like "[!0-9A-Za-z]" & C & "[!0-9A-Za-z]" Then
          Cel = Replace(Cel, C.Value, C.Offset(, 1).Value)
        End If
      Next
    Next
  Next
  
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("F1:F" & LastRow), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
      .SetRange Range("D1:H" & LastRow)
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
  Columns("F:H").Delete
  
  Application.ScreenUpdating = True
End Sub

Wow this is really amazing - it even seems to pick out the longest matching phrase to replace when there are several overlapping words that can be replaced in numerous ways. Really incredible support guys, thank you so much!

 

[Rick Rothstein]

Wow this is really amazing - it even seems to pick out the longest matching phrase to replace when there are several overlapping words that can be replaced in numerous ways.

What I did to accomplish this (all hidden from view by the Application.ScreenUpdating=False statement) was to create three helper columns and then sort the word/phrases list along with the helper columns. The first helper column was just the numbers 1, 2, 3, etc. down from the first data cell to the last data cell... this is used at the end of the code to sort things back to the way they were before the macro started. The second helper column, which was used as the primary sort key, contained the count of the number of spaces in the words/phrases list from most spaces down to least spaces... that way, short phrases that might be contained within longer ones were guaranteed to be looked at afterward, not beforehand. The third helper column, which was used as a secondary sort, contained the length of the text from longest on down to shortest... that way, short words or phrases that could be contained in longer ones would, again, be guaranteed to be looked at afterwards rather than beforehand. After the replacements were done and the list sorted back to the way it was at the beginning, I simply deleted the helper columns and turned ScreenUpdating back on.

 

[JoeMo]

The following code handles stand-alone words and multi-word phases PLUS it will work no matter what order the words and phrases in Column D are in (just write your list and their replacements in any order and the code will take care of making sure smaller included words or phrases to not get replaced before larger ones that contain them...

Sub delonteReplace3()
  Dim X As Long, LastRow As Long, C As Range, Cel As Range, S As Variant
  Application.ScreenUpdating = False
  LastRow = Cells(Rows.Count, "D").End(xlUp).Row
  For X = 1 To LastRow
    Cells(X, "F").Value = X
    Cells(X, "G").Value = UBound(Split(Cells(X, "D").Value))
    Cells(X, "H").Value = Len(Cells(X, "D").Value)
  Next
  
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("G1:G" & LastRow), _
      SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  ActiveSheet.Sort.SortFields.Add Key:=Range("H1:H" & LastRow), _
      SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
      .SetRange Range("D1:H" & LastRow)
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
  
  For Each C In Range("D1:D" & LastRow)
    For Each Cel In Intersect(ActiveSheet.UsedRange, Columns("A:C"))
      For X = Len(Cel) - Len(C) + 1 To 1 Step -1
        If Mid(" " & Cel & " ", X, Len(C) + 2) Like "[!0-9A-Za-z]" & C & "[!0-9A-Za-z]" Then
          Cel = Replace(Cel, C.Value, C.Offset(, 1).Value)
        End If
      Next
    Next
  Next
  
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("F1:F" & LastRow), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
      .SetRange Range("D1:H" & LastRow)
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
  Columns("F:H").Delete
  
  Application.ScreenUpdating = True
End Sub

Very nice Rick!

 

[Rick Rothstein]

Very nice Rick!

Hey, thanks Joe!

 

[delonte]

Sorry to bring this back up but this code has been giving me some problems. Sometimes the macro replaces strings of letters that are only a part of a word. So for example if I want the macro to replace the word 'ice' with 'cold', if it sees a word like 'nice' it will replaced it to 'ncold'. This error didn't show up in small tests, but now that I have hundreds of words being replaced in same go, excel seems to screw up for some reason.

Wondering if there's anything in the code that would lead to this and also wondering if the macro only goes through a paragraph once to replace the word within it, or it keeps looking through the text and replacing any new words it sees (even the new words that the macro replaced itself - which could lead to huge loops and be problematic).