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.



In article ,
"Brad" wrote:

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.

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" wrote in message
...
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" wrote in message
...
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" wrote in message
...
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.

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.

"J.E. McGimpsey" wrote in message
...
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.



In article ,
"Brad" wrote:

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.


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.548 / Virus Database: 341 - Release Date: 05/12/2003

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

In article ,
"Stuart" wrote:

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.

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.

"J.E. McGimpsey" wrote in message
...
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

In article ,
"Stuart" wrote:

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.


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.548 / Virus Database: 341 - Release Date: 05/12/2003