VBA: Find and Replace Exact Match Words

D

delonte

New Member
Joined
Jun 11, 2014
Messages
13
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:

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
 
Last edited:
Sort by date Sort by votes
delonte said:
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.
Click to expand...
I would need to see a file where this happens (I need to see that file before my code is run against it) so I can debug it "live" as it happens. Can you send a copy of such a workbook for me to test? My email address is...

rick DOT news AT verizon DOT net

Please include the title of this thread in your email so I relate the file you send back here and so I can find this thread again to post my response.
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Rick Rothstein said:
I would need to see a file where this happens (I need to see that file before my code is run against it) so I can debug it "live" as it happens. Can you send a copy of such a workbook for me to test? My email address is...

rick DOT news AT verizon DOT net

Please include the title of this thread in your email so I relate the file you send back here and so I can find this thread again to post my response.
Click to expand...


Thanks alot for getting back to me Rick, I've isolated the problem to a very simple example.

Cell A1 write: bot robot
Cell D1 write: bot
Cell E1 write: droid

Then if you run the macro 'delontereplace3' you prepared, the result will be:

Cell A1 becomes: droid rodroid

The first word gets replaced because its exact match (as it should) but the second word 'robot' should not get replaced at all. This problem only seems to occur when a word in A1 has been replaced once, then for future instances it no longer looks for exact match to replace.
 
Upvote 0
delonte said:
Thanks alot for getting back to me Rick, I've isolated the problem to a very simple example.

Cell A1 write: bot robot
Cell D1 write: bot
Cell E1 write: droid

Then if you run the macro 'delontereplace3' you prepared, the result will be:

Cell A1 becomes: droid rodroid

The first word gets replaced because its exact match (as it should) but the second word 'robot' should not get replaced at all. This problem only seems to occur when a word in A1 has been replaced once, then for future instances it no longer looks for exact match to replace.
Click to expand...

Ahh, okay, I see. It looks like my original testing was faulty.:oops: Give this new code a try...
Code: 
Sub delonteReplace4()
  Dim X As Long, LastRow As Long, C As Range, Cel As Range, S As Variant, CellText As String
  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"))
      CellText = Cel.Value
      For X = Len(CellText) To 1 Step -1
        If Mid(" " & CellText & " ", X, Len(C) + 2) Like "[!0-9A-Za-z]" & C & "[!0-9A-Za-z]" Then
          Mid(CellText, X, Len(C)) = String(Len(C), "@")
        End If
      Next
      Cel = Replace(CellText, String(Len(C), "@"), C.Offset(, 1))
    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
 
Upvote 0
Rick Rothstein said:
Ahh, okay, I see. It looks like my original testing was faulty.:oops: Give this new code a try...
Code: 
Sub delonteReplace4()
  Dim X As Long, LastRow As Long, C As Range, Cel As Range, S As Variant, CellText As String
  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"))
      CellText = Cel.Value
      For X = Len(CellText) To 1 Step -1
        If Mid(" " & CellText & " ", X, Len(C) + 2) Like "[!0-9A-Za-z]" & C & "[!0-9A-Za-z]" Then
          Mid(CellText, X, Len(C)) = String(Len(C), "@")
        End If
      Next
      Cel = Replace(CellText, String(Len(C), "@"), C.Offset(, 1))
    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
Click to expand...


This code seems to work but the problem is it took 1 hour 20 minutes to process! (and I have a very fast computer). It also broke my internet connection while it was running (could be a coincidence but the network went down when I started it and only returned after it ended). Just for reference I have a bout a 1000 rows in column D and E and the bit of text where the replacing is occuring in A1 is about 500 words paragraph. For reference, the last macro (v3) you gave use to run in about 15-30 seconds.
 
Upvote 0
If cut the number of rows from 2000 to 1000, the time is also halved. Seems there is a limit to how big of a file you can work with using this code. Is there anything that can be done or I have to just suck it up and wait one hour everytime I want to run this macro?

(internet problem I mentioned above wasn't related)
 
Upvote 0
Thank your very much Rick

I have a doubt in this code:

Sometimes the macro replaces strings of letters that are only a part of a word. 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.
 
Upvote 0
svelpula said:
Thank your very much Rick

I have a doubt in this code:

Sometimes the macro replaces strings of letters that are only a part of a word. 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.
Click to expand...
Which of my posted codes did you use? The modified code I posted in Message #23 is supposed to take care of that problem.
 
Upvote 0
Yes Rick... its working well in excel.

I am sorry to bothered you

Actually I want to replace in word document from excel list.
Column A contains wrongs words (to be find words), column B contains right words (to be replaced words)
I want to find column A values in active word document. I have created an object and connected Excel application and succeed in find and replace, but i was stuck up at finding of whole words


can you please explain this part of code and suggest anything which will give us a progress

For Each C In Range("D1:D" & LastRow)
For Each Cel In Intersect(ActiveSheet.UsedRange, Columns("A:C"))
CellText = Cel.Value
For X = Len(CellText) To 1 Step -1
If Mid(" " & CellText & " ", X, Len(C) + 2) Like "[!0-9A-Za-z]" & C & "[!0-9A-Za-z]" Then
Mid(CellText, X, Len(C)) = String(Len(C), "@")
End If
Next
Cel = Replace(CellText, String(Len(C), "@"), C.Offset(, 1))
Next
Next
 
Upvote 0
Hello Rick.
I would like to use the macro in this post (#23) to find whole words from a list (as you wrote it), but rather than replace the word, simply change the color of the word. I tried using the same word in both columns of the find/replace table (columns D and E, I believe) with the second column in the desired color, but the color of the replacement is not preserved. I was wondering if the macro lends itself to a simple tweek that accomplishes this? I am not asking you to devote any substantial time to this question.

Regards,

Alan (also in N.J.)
 
Upvote 0
Alan in NJ said:
Hello Rick.
I would like to use the macro in this post (#23) to find whole words from a list (as you wrote it), but rather than replace the word, simply change the color of the word. I tried using the same word in both columns of the find/replace table (columns D and E, I believe) with the second column in the desired color, but the color of the replacement is not preserved. I was wondering if the macro lends itself to a simple tweek that accomplishes this? I am not asking you to devote any substantial time to this question.
Click to expand...
It will take different code, but that should not be too hard to write, but you need to tell us about your set up...

Where is the text you want the words highlighted in located at?

Where is the word list you want to process located at?

Will all the located words be the same color? If so, what color?
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question
VBA create bulk Word docs from Excel
Replies
2
Views
477
Fluff
Fluff
M
  • Solved
Find and Replacing text in formula via VBA
Replies
5
Views
767
Joe4
Joe4
J
  • Question
Another Find/Replace Question - Excel(vba) to Word
Replies
0
Views
404
jagrenet
J
M
  • Question
VBA Code - If statement to find exact match between columns as well as if value exists in another column
Replies
0
Views
756
MHamid
M
F
  • Question
Using VBA to Find and Replace Phrases in Word with Text from Excel Cell
Replies
6
Views
5K
aranjan
A

Forum statistics

Threads
1,216,165
Messages
6,129,235
Members
449,496
Latest member
Patupaiarehe

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top