Point Me. Searching strings for lists of keywords

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

How would you go about this? Column of cells of text. I want to seach each cell for a list of words and, if a word is found, put a value in a cell. Example. If text contains any of the words Chevy, Buick, Caddilac, i'd like to out that word in an ajacent cell for indexing purposes. The list of words will be pretty long so nested if's are not a good approach. Thanks for any suggestions.
 
One way:

Public Sub ExtractForIndex()
Dim vKeyWords As Variant
Dim rCell As Range
Dim rFound As Range
Dim i As Long
Dim sFoundAddr As String

vKeyWords = Array("Chevy", "Buick", "Cadillac")
With Columns(1).Cells
For i = 0 To UBound(vKeyWords)
Set rFound = .Find( _
What:=vKeyWords(i), _
LookIn:=xlValues, _
LookAt:=xlPart, _
MatchCase:=False)
If Not rFound Is Nothing Then
sFoundAddr = rFound.Address
Do
rFound.Offset(0, 1).Value = vKeyWords(i)
Set rFound = .FindNext(After:=rFound)
Loop Until rFound.Address = sFoundAddr
End If
Next i
End With
End Sub

Note: This assumes only one keyword per cell. If multiple keywords
are in a cell, only the last will be listed. If that's the case and
you need assistance in modifying the macro, post back.
 
Here's another approach using Match:

Sub Lookfor()
Dim cell As Range, res As Variant
For Each cell In Range("A1:A25")
res = Application.Match(cell.Value, _
Array("Chevy", "Buick", "Cadillac"), 0)
If Not IsError(res) Then
cell.Offset(, 1).Value = cell.Value
End If
Next
End Sub


Brad said:
How would you go about this? Column of cells of text. I want to seach
each cell for a list of words and, if a word is found, put a value in a
cell. Example. If text contains any of the words Chevy, Buick, Caddilac,
i'd like to out that word in an ajacent cell for indexing purposes. The
list of words will be pretty long so nested if's are not a good approach.
Thanks for any suggestions.
 
I think I misunderstood your post.

Tim Zych said:
Here's another approach using Match:

Sub Lookfor()
Dim cell As Range, res As Variant
For Each cell In Range("A1:A25")
res = Application.Match(cell.Value, _
Array("Chevy", "Buick", "Cadillac"), 0)
If Not IsError(res) Then
cell.Offset(, 1).Value = cell.Value
End If
Next
End Sub



each cell for a list of words and, if a word is found, put a value in a
cell. Example. If text contains any of the words Chevy, Buick, Caddilac,
i'd like to out that word in an ajacent cell for indexing purposes. The
list of words will be pretty long so nested if's are not a good approach.
Thanks for any suggestions.
 
It would be of great help to me, if you could demonstate
the technique for the situation where multiple keywords
could exist within the same cell.

Regards.
 
One way:

To put all the terms into one cell, replace the Do...Loop with:

Do
With rFound.Offset(0, 1)
.Value = IIf(IsEmpty(.Value), "", _
.Text & ", ") & vKeyWords(i)
End With
Set rFound = .FindNext(After:=rFound)
Loop Until rFound.Address = sFoundAddr

To put applicable terms into adjoining cells, replace the do loop
with:

Do
With rFound.Offset(0, 1).Resize(
1, UBound(vKeyWords))
.Item(Application.CountA(.Cells) + _
1).Value = vKeyWords(i)
End With
Set rFound = .FindNext(After:=rFound)
Loop Until rFound.Address = sFoundAddr
 
Many thanks for that. I'm hoping to adapt the routine so as to
build 3 arrays to hold all found instances of the keywords,
and then to copy them to a new workbook.

Regards.
 
Back
Top