Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Intersect and Union
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Intersect and Union
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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Intersect and Union
Thank you very much. I take note. It works
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Intersect or Union? | Excel Programming | |||
Intersect or Union? | Excel Programming | |||
Complex Union Intersect | Excel Worksheet Functions | |||
Equivalent of Minus in Excel. Also Union, Intersect. | Excel Worksheet Functions | |||
Intersect, Union... where's Deduct? | Excel Programming |