Find & Replace To Match Whole Word Only - VBA Adjustment

[PeeterP]

Hi i found the macro online and did little changes to it, it works great, but i need an adjustment so that it will match whole word only.

Here is my VBA:

Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values

Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant

'Create variable to point to your table
  Set tbl = Worksheets("List Of Locations To Rmove").ListObjects("Table1")

'Create an Array out of the Table's Data
  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
  
'Designate Columns for Find/Replace data
  fndList = 1
  rplcList = 2

'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 2)
        If sht.Name = "KWs Cleaning Sheet" Then
          
          sht.Cells.Replace What:=" " & myArray(fndList, x), Replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        
        End If
      Next sht
  Next x

End Sub

If i try to replace word "put" by word "insert" it will also turn word "input" into word "inreplace" and that's what i want to avoid by applying match only whole word function which for some reason isn't included in excel.

Anyone of you excel wizards know how to tweak my vba to make it work that way?

 

[PeeterP]

OK i was lookig for the answer elswhere and found out that i could separate text to columns with using space as delimiter and then find and remove the words using LookAt:=xlWhole instead of LookAt:=xlPart that would be a solution to my problem, but i don't know how to put all those separated words back together.

Any suggestions to that problem?

 

[Akuini]

OK i was lookig for the answer elswhere and found out that i could separate text to columns with using space as delimiter and then find and remove the words using LookAt:=xlWhole instead of LookAt:=xlPart that would be a solution to my problem, but i don't know how to put all those separated words back together.

Any suggestions to that problem?

I don't understand why you need to 'separate text to columns with using space as delimiter', I think just changing LookAt:=xlPart to LookAt:=xlWhole would work.
Can you give some example of the data & explain what are you trying to do?
This part of your code:
What:=" " & myArray(fndList, x)
Does it mean there is a space in front of the data in the cells in question?

 

[Rick Rothstein]

OK i was lookig for the answer elswhere and found out that i could separate text to columns with using space as delimiter and then find and remove the words using LookAt:=xlWhole instead of LookAt:=xlPart that would be a solution to my problem, but i don't know how to put all those separated words back together.

Any suggestions to that problem?

The main problem with that approach is if the word you want to find is next to a punctuation mark (for example, a comma, period, question mark, dash, etc.) or is next to an opening or closing bracket and probably some other situation as well. What you want is doable, but probably not super fast. If you could describe your data layout and show some examples of what kinds of text might be in the various locations, I am sure we could give you code to handle it.

 

[PeeterP]

I can't use LookAt:=xlWhole without separating all individual words into cells. Here is an example of one of the words, i want to to remove a name of the location:

cheapest car insurance los angeles ca

Word to look for would be - ca
Word to replace it by would be nothing to basically remove - ca
so if i use LookAt:=xlWhole it would be only looking for a cell that has noting else than "ca" in it, but if i use LookAt:=xlPart it would turn "cheapest car insurance los angeles ca" into "cheapest r insurance los angeles"

What:=" " & myArray(fndList, x)
Does it mean there is a space in front of the data in the cells in question?

Yes i was replacing everything found by nothing, so that i would remove all locations like cities and states from all cells that's why i added space before everything that suppose to be look for.

 

[PeeterP]

The main problem with that approach is if the word you want to find is next to a punctuation mark (for example, a comma, period, question mark, dash, etc.) or is next to an opening or closing bracket and probably some other situation as well. What you want is doable, but probably not super fast. If you could describe your data layout and show some examples of what kinds of text might be in the various locations, I am sure we could give you code to handle it.

No there is only alphanumeric characters.

When i select all data that i have previously separated into individual cells copy and paste them into notepad then i replace al tabspaces by single spaces it will join all cells into 1 column, does anyone know how to do this in excel?

 

[Rick Rothstein]

No there is only alphanumeric characters.

When i select all data that i have previously separated into individual cells copy and paste them into notepad then i replace al tabspaces by single spaces it will join all cells into 1 column, does anyone know how to do this in excel?

I would still like to see samples of your text and lists and have some indication where things are located at... you know, just in case we have a different approach in mind than the one you seem to be locked on.

 

[PeeterP]

List of data to remove locations from:

\

List of locations to remove:

 

[Snakehips]

Peter,

It's way past bed time and I have only just seen you last post. I now don't understand what you are replacing with what! ??

I had produced the below thinking you had text in Cleaning sheet and that LofL sheet contained list of words to find col 1 and replace., col 2. ??
For me the code below does that and to some extent should limit to whole word or whole word plus basic punctuation.
If it isn't what you want then maybe it will give you or someone a start.

Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values


Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
Dim cell As Range, rng As Range, rngArea As Range
Dim vFind As String, vReplace As String
Dim arrSplit() As String
Dim found As Boolean
Dim Ln As Integer




'Create variable to point to your table
  Set tbl = Worksheets("List Of Locations To Rmove").ListObjects("Table1")


'Create an Array out of the Table's Data
  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
  
'Designate Columns for Find/Replace data
  fndList = 1
  rplcList = 2
Set sht = ActiveSheet  '???assuming run from within the vcleaning sheet?? as you did not have sht set
If sht.Name = "KWs Cleaning Sheet" Then
'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 2)
        
            Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    If Not rng Is Nothing Then
    
        vFind = myArray(fndList, x)


        vReplace = myArray(rplcList, x)
        
        Ln = Len(vFind)
        
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        For Each rngArea In rng.Areas
            For Each cell In rngArea.Cells
                found = False
                arrSplit = Split(cell.Value, " ")
                For i = LBound(arrSplit) To UBound(arrSplit)
            Select Case Len(arrSplit(i))
            
            Case Ln
                    If UCase(arrSplit(i)) = UCase(vFind) Then
                        arrSplit(i) = vReplace
                        found = True
                    End If
              Case Ln + 1
              Punctn = Right(UCase(arrSplit(i)), 1)
              If Not Punctn Like "[A-Z,0-9]" Then
                    If Left(UCase(arrSplit(i)), Ln) = UCase(vFind) Then
                        arrSplit(i) = vReplace & Punctn
                        found = True
                    End If
                    
                   End If
             Case Else
             End Select
                    
                Next i
                If found Then
                    cell.Value = Trim(Join(arrSplit, " "))
                End If
            Next cell
        Next rngArea


        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End If
    
  Next x
End If
End Sub

Hope that helps.

 

[PeeterP]

Thanks a lot Snakehips, it works exactly the way i wanted!