Hi u473,

You would be doing yourself a huge favour if you always write Option
Explicit at the top of the module and only dimension one variable per
line.

The following works for me (beware line wrap)...

Sub FindKeys()
Dim WB2 As Workbook
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Dim MyPath As String
Dim X As Long
Dim Y As Long
Dim Joined As String
Dim R As Range
Dim SearchRange As Range
Dim RowSlice As Range
Dim K1 As String ' Keyword to Search
Dim K2 As String ' Subkeyword to Search

MyPath = "C:\Work\"

Set SH1 = ThisWorkbook.Worksheets("Sheet1")
Set WB2 = Workbooks.Open(MyPath & "MyFile.xls")
Set SH2 = WB2.Worksheets("Sheet1")
K1 = InputBox("Key 1", "Ok")
K2 = InputBox("Key 2", "Ok")
Y = 2

With SH2
Set SearchRange = Intersect(.UsedRange,
Union(.Range("A:B"), .Columns("D")))
For X = 2 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, K1, vbTextCompare) 0 Then
If InStr(1, Joined, K2, vbTextCompare) 0 Then
SH1.Cells(Y, 1).Value = .Cells(X, 4).Value
Y = Y + 1
End If
End If
Next
End With

SH1.Activate ' Return to ThisWorkbook
SH1.Cells(1, 1).Activate
End Sub


Br, Nick.