Delete words in a column based on separate column

cpmurray1985

New Member
Joined
Mar 10, 2022
Messages
15
Office Version
  1. 365
Platform
  1. Windows
Hello everyone,

I'm completely new to VBA and editing, so I need assistance with editing the code so that it removes specific words in a column from a list of words in another column. I found the following code from another post and it works, however, it will delete words that have the characters in them. An example:

(Existing words)
A1: Go in Isabelle
A2: Cats are indoors Arethe
A3: The fox forgot tomorrow is too late.

(Words I want removed)
C1: In
C2: The
C3: For
C4: To
C5: Is
C6: At

Results:
Go Abelle
C are doors Are
fox got morrow o late


How can I edit the code so it does exact matches and is not case sensitive (such as 'To' would also remove 'to', for example)? I would want to remove words such as "in" from the columns, but not from words like Coaching, Indoors, etc.

In case the link above does not work, I have posted the code below. Thank you.

VBA Code:
Sub EricG()
   For Each Cl In Range("C1", Range("C" & Rows.Count).End(xlUp))
      Range("A:A").Replace Cl.Value, "", xlPart, , False, , False, False
   Next Cl
End Sub
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Maybe:
VBA Code:
Option Explicit
Sub test()
Dim Lr&, Lr2&, i&, cell As Range, cell2 As Range, arr()
Lr = Cells(Rows.Count, "A").End(xlUp).Row
Lr2 = Cells(Rows.Count, "C").End(xlUp).Row
ReDim arr(1 To Lr, 1 To 1)
    For i = 1 To Lr
        arr(i, 1) = " " & Cells(i, 1) & " "
        For Each cell2 In Range("C1:C" & Lr2)
            If InStr(1, arr(i, 1), " " & cell2 & " ") > 0 Then
                arr(i, 1) = Replace(arr(i, 1), cell2, "")
            End If
            If InStr(1, arr(i, 1), " " & LCase(cell2) & " ") > 0 Then
                arr(i, 1) = Replace(arr(i, 1), LCase(cell2), "")
            End If
        Next
    Next
Range("A1").Resize(Lr).Value = arr
End Sub
 
Upvote 0
You could try this. At the moment it is written to put the resukts in column B so you can compare. If it does what you want and you want to actually replace the original column A data then remove the red code.

Rich (BB code):
Sub Replace_Words()
  Dim RX As Object
  Dim a As Variant
  Dim i As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  RX.Pattern = "\b(" & Join(Application.Transpose(Range("C1", Range("C" & Rows.Count).End(xlUp))), "|") & ")\b"
  With Range("A1", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      a(i, 1) = Application.Trim(RX.Replace(a(i, 1), " "))
    Next i
    .Offset(, 1).Value = a
  End With
End Sub

Here is my sample data and results.
I have assumed no blank cells in the column C list.

cpmurray1985.xlsm
ABC
1Go in IsabelleGo IsabelleIn
2Cats are indoors AretheCats are indoors AretheThe
3The fox forgot tomorrow is too late.fox forgot tomorrow too late.For
4To
5Is
6At
Sheet1
 
Upvote 0
Solution
You could try this. At the moment it is written to put the resukts in column B so you can compare. If it does what you want and you want to actually replace the original column A data then remove the red code.

Rich (BB code):
Sub Replace_Words()
  Dim RX As Object
  Dim a As Variant
  Dim i As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  RX.Pattern = "\b(" & Join(Application.Transpose(Range("C1", Range("C" & Rows.Count).End(xlUp))), "|") & ")\b"
  With Range("A1", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      a(i, 1) = Application.Trim(RX.Replace(a(i, 1), " "))
    Next i
    .Offset(, 1).Value = a
  End With
End Sub

Here is my sample data and results.
I have assumed no blank cells in the column C list.

cpmurray1985.xlsm
ABC
1Go in IsabelleGo IsabelleIn
2Cats are indoors AretheCats are indoors AretheThe
3The fox forgot tomorrow is too late.fox forgot tomorrow too late.For
4To
5Is
6At
Sheet1
Thank you, this was exactly what I was looking for!
 
Upvote 0
You're welcome. Thanks for the follow-up. :)
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,188
Members
448,554
Latest member
Gleisner2

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