identify specific keywords (plural) in a column of text

[dominicp]

So i'm try to automate a process that I currently do using filters.

Here is the problem:

I have a list of text in a column (usually 700 or so entries).

I need to remove any entries that contain 1 of 42 keywords.

So I need a fast way to search each cell for each one of the 42 key words and flag the cell for deletion if contains anyone of the 42.

example
A
1 This field has keyword1
2 This field has keyword2
3 This field doesn't have any of the 42 keywords


somewhere else I would have a list of keywords in a column.

Thanks for the help.

 

[taigovinda]

Slight tweak to Hiker's code, should fix problem in post #8:

Option Explicit
Option Base 1
Sub CKKeywords()
Dim c As Range, a As Long, b As Long
Dim MyKeys As Variant
Application.ScreenUpdating = False
MyKeys = Sheets("Keywords").Range("A1:A" & Sheets("Keywords").Cells(Rows.Count, 1).End(xlUp).Row)
With Sheets("Sheet1")
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
  For a = LBound(MyKeys) To UBound(MyKeys)
    b = 0
    On Error Resume Next
    b = WorksheetFunction.Find(MyKeys(a, 1), c, 1)
    On Error GoTo 0
    If b > 0 Then
      c.Offset(, 1) = "Delete"
      Exit For
    End If
  Next a
Next c
End With
Application.ScreenUpdating = True
End Sub

 

[hiker95]

dominicp,

I modified the above macro to account for the fact that all your data cells contain a trailing space character in each data cell in your Sheet1 and sheet Keywords.

 

[taigovinda]

Hiker, I think you may still need this:

MyKeys = Sheets("Keywords").Range("A1:A" & Sheets("Keywords").Cells(Rows.Count, 1).End(xlUp).Row)

...otherwise you are taking your end row from sheet1 (presuming you call the macro from sheet1). Also I'm not sure that this is doing anything:

With Sheets("Sheet1")

don't you need to insert some dots within the with block? e.g.,

For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))

...I had a couple of times used Rows.Count without specifying the sheet/book, and called up an error because I was working a 2003 and a 2007 file together.

 

[hiker95]

dominicp,

One slight change to the code:

Option Explicit
Option Base 1
Sub CKKeywords()
Dim c As Range, a As Long, b As Long
Dim MyKeys As Variant
Application.ScreenUpdating = False
MyKeys = Sheets("Keywords").Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
With Sheets("Sheet1")
  For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    For a = LBound(MyKeys) To UBound(MyKeys)
      b = 0
      On Error Resume Next
      b = WorksheetFunction.Find(Trim(MyKeys(a, 1)), c, 1)
      On Error GoTo 0
      If b > 0 Then
        c.Offset(, 1) = "Delete"
        Exit For
      End If
    Next a
  Next c
End With
Application.ScreenUpdating = True
End Sub

 

[hiker95]

dominicp,

Thanks everyone - the following corrects the array MyKeys to the correct number of items.

Option Explicit
Option Base 1
Sub CKKeywords()
Dim c As Range, a As Long, b As Long
Dim MyKeys As Variant
Application.ScreenUpdating = False
MyKeys = Sheets("Keywords").Range("A1:A" & Sheets("Keywords").Cells(Rows.Count, 1).End(xlUp).Row)
With Sheets("Sheet1")
  For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    For a = LBound(MyKeys) To UBound(MyKeys)
      b = 0
      On Error Resume Next
      b = WorksheetFunction.Find(Trim(MyKeys(a, 1)), c, 1)
      On Error GoTo 0
      If b > 0 Then
        c.Offset(, 1) = "Delete"
        Exit For
      End If
    Next a
  Next c
End With
Application.ScreenUpdating = True
End Sub

 

[dominicp]

Thanks everyone...

Just one last question...do i have to modify the code at all depending on the number of key words I have...

I only gave you a sample of the 45 keywords i have.

Dominic

 

[taigovinda]

Hiker's code will figure out how many words are there