I have a Workbook named "MyFile" in which Sheet1 contains a list of
topics
in Col. "D", a Keyword in Col. "A" and a SubKeyword in Col. "B"
..
From ThisWorkbook, I want to prompted for the Keyword and Subkeyword
to be searched
in MyFile Sheet1 and return the content of Col. "D" in ThisWorkbook.
The Subkeyword can be left blank if necessary, and more than one row
can be returned in ThisWorkbook.
Since I use a With -End With structure, my attempts to place dot
prefixes has been unsuccessful.
Help appreciated.
..
Sub FindKeys()
Dim WB1, WB2 As Workbook
Dim SH1, SH2 As Worksheet
Dim MyPath As String
Dim X As Long, Y As Long
Dim Joined As String, Answer As String, Found As String
Dim R As Range, SearchRange As Range, RowSlice As Range
Dim K1, K2 As String ' Keyword and Subkeyword to Search
MyPath = "C:\Work\"
Set WB1 = ThisWorkbook
Set WS1 = WB1.Worksheets("Sheet1")
Set WB2 = Workbooks.Open(MyPath & "MyFile.xls")
Set WS2 = WB2.Worksheets("Sheet1")
K1 = InputBox("Key 1", "Ok")
K2 = InputBox("Key 2", "Ok")
Y = 2
With WS2
Set SearchRange = Intersect(ActiveSheet.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 And InStr(1, Joined, K2,
vbTextCompare) 0 Then
Found = .Cells(X, 4).Value
With WS1
.Cells(Y, 1).Value = Found
Y = Y + 1
End With
End If
Next
End With
WS1.Cells(1, 1).Select ' Return to ThisWorkbook
End Sub