"Find and Replace" macro finds items nested in larger words!

[IrishMist1748]

Hello!

I am using the following macro to auto find and replace multiple items at once with Sheet2 containing the items I want to "find and replace" (with 'finds' in column A and 'replaces' in column B) and Sheet1-column B is the text I am running the "find and replace" macro against:

Sub FindReplace()
Dim i As Integer
Dim FindStr As String
Dim RepStr As String
For i = 1 To 145
    FindStr = Sheet2.Range("A" & i).Value
    RepStr = Sheet2.Range("B" & i).Value
Worksheets("Sheet1").Range("B:B").Cells.Replace What:=FindStr, Replacement:=" RepStr"
Next i
End Sub

My problem/question is how do I change the code so it will only "find" whole "words" and do the appropriate replacement? Currently it is finding "c" mixed amongst other words instead of finding 'c' by itself.

Example:
Find: C, Replace with: complete
Find: CL, replace with: clear

Text searched: CL C Clock

Current results: completeL complete completelo completek
Desired result: clear complete clock

Thank you!
<table x:str="" style="border-collapse: collapse; width: 368pt;" width="490" border="0" cellpadding="0" cellspacing="0"><col style="width: 368pt;" width="490"><tbody><tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt; width: 368pt;" width="490" height="17">
</td> </tr></tbody></table>

 

[Jonmo1]

Try this...
Adjust the highlighted C's to an available column on Sheet1

Sub FindReplace()
Dim i As Integer, FindStr As String, RepStr As String, LR As Long, S1 As Worksheet, S2 As Worksheet
Set S1 = Worksheets("Sheet1")
Set S2 = Sheet2
LR = S1.Cells(Rows.Count,"B").End(xlup).Row
With S1.Range("C1:C" & LR)
    .Formula = "= "" "" & B1 & "" """
    .Copy
    S1.Range("B1").PasteSpecial xlpastevalues
 
    For i = 1 To 145
        FindStr = " " & S2.Range("A" & i).Value & " "
        RepStr = " " & S2.Range("B" & i).Value & " "
        S1.Range("B:B").Cells.Replace What:=FindStr, Replacement:= RepStr, LookAt:=xlPart
    Next i
 
    .Formula = "=TRIM(B1)"
    .Copy
    S1.Range("B1").PasteSpecial xlpastevalues
    .ClearConents
End With
End Sub

 

[IrishMist1748]

OK, I did as you suggested and put a space before and after each of my find words (" C ") and used the following macro:

Sub FindReplace()
Dim i As Integer
Dim FindStr As String
Dim RepStr As String
For i = 1 To 145
    FindStr = Sheet2.Range("A" & i).Value
    RepStr = Sheet2.Range("B" & i).Value
    
    Worksheets("Sheet1").Range("B:B").Cells.Replace What:=FindStr & " ", Replacement:=" " & RepStr & " ", LookAt:=xlPart
Next i
End Sub

and NOTHING HAPPENS!

 

[IrishMist1748]

Try this...
Adjust the highlighted C's to an available column on Sheet1

Sub FindReplace()
Dim i As Integer, FindStr As String, RepStr As String, LR As Long, S1 As Worksheet, S2 As Worksheet
Set S1 = Worksheets("Sheet1")
Set S2 = Sheet2
LR = S1.Cells(Rows.Count,"B").End(xlup).Row
With S1.Range("C1:C" & LR)
    .Formula = "= "" "" & B1 & "" """
    .Copy
    S1.Range("B1").PasteSpecial xlpastevalues
 
    For i = 1 To 145
        FindStr = " " & S2.Range("A" & i).Value & " "
        RepStr = " " & S2.Range("B" & i).Value & " "
        S1.Range("B:B").Cells.Replace What:=FindStr, Replacement:= RepStr, LookAt:=xlPart
    Next i
 
    .Formula = "=TRIM(B1)"
    .Copy
    S1.Range("B1").PasteSpecial xlpastevalues
    .ClearConents
End With
End Sub

No output to column C, sheet1?????
(Also changed spelling of .ClearConents to .ClearContents)

 

[Jonmo1]

It's temporarily using column C, clears it's contents afterwards..

Basically, puts a formula in column C
=" " & B1 & " "

This is to accomplish putting the spaces at the beginning and end of the sentences in column B.
Copies column C, and pastes values over the original data in column B.

Then does the find/replace using spaces around the findwhat and replacewith.

Then uses another formula (Trim) to remove the extraneous spaces
Then clears the contents of columnC.

 

[IrishMist1748]

Thanks!

Works well! You guys are GREAT!

 

[IrishMist1748]

Is there a way to put an exception in the code for a few of my 'find' words so so it only looks for a space after the word and not before BUT will work the same way you designed it for the rest of the words?

Example of exception:

find: 14ky
replace: 14 karat white gold

Thanks!

BBS

 

[Jonmo1]

Perhaps if you manually put the spaces "as required" in columns A and B of sheet2.

Then change these 2 lines
FindStr = " " & S2.Range("A" & i).Value & " "
RepStr = " " & S2.Range("B" & i).Value & " "
to
FindStr = S2.Range("A" & i).Value
RepStr = S2.Range("B" & i).Value

 

[IrishMist1748]

Does this mean I would have to put the required spaces in all 300 'find' words or just the exceptions?

 

[IrishMist1748]

OK, I am sorry I didn't look more carefully before asking! I can see now that I need to manually put all the spaces or no spaces in.

Is there a way to do this with a logic statement or will that not work here?

 

[Jonmo1]

You could do something like this

    For i = 1 To 145
        Select Case Range("A" & i).Value
            Case "14ky", "another exception", "something else"
                FindStr = S2.Range("A" & i).value & " "
                RepStr = S2.Range("B" & i).Value & " "
            Case Else
                FindStr = " " & S2.Range("A" & i).Value & " "
                RepStr = " " & S2.Range("B" & i).Value & " "
        End Select
        S1.Range("B:B").Cells.Replace What:=FindStr, Replacement:= RepStr, LookAt:=xlPart
    Next i