Finding rows that contain Keyword1and Keyword2 in any part of fieldin Column A, B or D

[u473]

I need to find rows that contain Keyword1and Keyword2 in any part of
field in Column A, B or D
For instance :

Col.A Col.B Col.D
1. WordX Keyword1 WordZ
2. Keyword2 WordY Prefix&Keyword1
3. Keyword1
4. Keyword1 WordZ Keyword2&Suffix

In this case, rows 3 and 4 would be retrieved
Help appreciated,
J.P.

 

[Rick Rothstein]

I think you meant that rows 2 and 4 would be retrieved, not rows 3 and 4,
right? If so, give this code a try...

Dim X As Long, Joined As String, Answer As String
Dim R As Range, SearchRange As Range, RowSlice As Range
Set SearchRange = Intersect(ActiveSheet.UsedRange, _
Union(Range("A:B"), Columns("D")))
For X = 1 To SearchRange.Rows.Count
Set RowSlice = Intersect(Rows(X), SearchRange)
Joined = ""
For Each R In RowSlice
Joined = Joined & Chr(1) & R.Value
Next
If InStr(1, Joined, "Keyword1", vbTextCompare) > 0 And _
InStr(1, Joined, "Keyword2", vbTextCompare) > 0 Then
Answer = Answer & X & ","
End If
Next
Answer = Left(Answer, Len(Answer) - 1)
MsgBox Answer

 

[u473]

Thanks a lot, you were right for my test sample.
It works fine, however, how do I handle it if I have more than one
answer ?
I will try putting the answer in a loop.

 

[u473]

Ok, I resolved my hurdle for multiple answers by moving the
Answer = Left(Answer, Len(Answer) - 1)
MsgBox Answer
.... above the End If
Thank you again, I learned something.

 

[Rick Rothstein]

It was not clear to me from your initial posting what you wanted to do with
the row numbers. Here is a modification to my previously posted code to put
the row numbers in an array named RowNumbers with indexes from 1 to the
number of rows meeting your criteria.

Dim X As Long, Index As Long, RowNumbers() As Long
Dim R As Range, SearchRange As Range, RowSlice As Range, Joined As String
Set SearchRange = Intersect(ActiveSheet.UsedRange, _
Union(Range("A:B"), Columns("D")))
ReDim RowNumbers(1 To SearchRange.Rows.Count)
For X = 1 To SearchRange.Rows.Count
Set RowSlice = Intersect(Rows(X), SearchRange)
Joined = ""
For Each R In RowSlice
Joined = Joined & Chr(1) & R.Value
Next
If InStr(1, Joined, "Keyword1", vbTextCompare) > 0 And _
InStr(1, Joined, "Keyword2", vbTextCompare) > 0 Then
Index = Index + 1
RowNumbers(Index) = X
End If
Next
ReDim Preserve RowNumbers(1 To Index)
' Let's see the results
For X = 1 To UBound(RowNumbers)
MsgBox RowNumbers(X)
Next

The last three lines just show you the result of the code above them... at
this point in the code, you would simply process the RowsNumbers array as
needed rather then MessageBox'ing them.