Thread: Remove word(s) from string beginning with words from this array

Hi agf,

Is it always going to be second word in the sentence, else you need to provide the complete list containing fox, turtle etc. Thanks.

Regards,
DILIPandey

<click on below 'star' if this helps>

Hello agf,

This macro starts with cell "A1" on "Sheet1" and continues down column "A" to the last cell with data. Case is ignored and full word matches are made. Words like "jump" and "jumped" are seen as two different words. All occurrences within the string will be replaced.

Add a new VBA module to your workbook's VBA project. Copy and paste the code below into it. You can then call it from your VBA code or running manually. Change the worksheet name and starting cell to match where your data is located.

' Thread:  http://www.excelforum.com/excel-general/806819-remove-word-s-from-string-beginning-with-words-from-this-array.html
' Poster:  agf12555
' Written: December 22, 2011
' Author:  Leith Ross

Sub RemoveWords()

    Dim Data As Variant
    Dim DeleteWords As Variant
    Dim RegExp As Object
    Dim Rng As Range
    Dim RngEnd As Range
    Dim Text As String
    Dim Wks As Worksheet
    
        Set Wks = Worksheets("Sheet1")
        Set Rng = Wks.Range("A1")
        
        DeleteWords = Array("fox", "jumped", "turtle")
        
          ' Autosize the range
            Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
            Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
            
          ' Add tags to parse full words only.
            For I = 0 To UBound(DeleteWords)
                DeleteWords(I) = "\b" & DeleteWords(I) & "\b"
            Next I
            
          ' Use pattern matching to replace the words
            Set RegExp = CreateObject("VBScript.RegExp")
            RegExp.Global = True
            RegExp.IgnoreCase = True
            RegExp.Pattern = Join(DeleteWords, "|")
            
              ' Copy cell values into an array
                Data = Rng.Value
                
                  ' Match and replace the words
                    For I = 1 To UBound(Data, 1)
                        Text = Data(I, 1)
                        Text = RegExp.Replace(Text, "")
                        Data(I, 1) = Application.WorksheetFunction.Trim(Text)
                    Next I
                
              ' Copy the modified array back into the cells
                Rng.Value = Data
           
End Sub

Hello agf,

That is an easy fix. Find the For loop shown below in the macro and replace it with code below.

          ' Add tags to parse full words only.
            For I = 0 To UBound(DeleteWords)
                DeleteWords(I) = "\b" & DeleteWords(I) & "*\b"
            Next I