Find keywords and post on different sheets

[JoeDelcambre]

I am trying to write a macro (possible 2 macros) to find 2 sets of keywords on Sheet 3.

First query/macro:
Search Sheet 3 only.
Sheet 4 can only have terms from "Set 1". If the query finds a line where there are words from only Set 1, results should be pasted on Sheet 4.
If the query finds a row with words from both Sets 1 and 2, those lines should pasted into Sheet 6.

The keywords are:
Set 1
"abc"
"def"
"xyz"


Second query/macro:
Search Sheet 3 only.
Sheet 5 can only have terms from "Set 2". If results from this query finds a line with only words from Set 2, results should be pasted on Sheet 5. If the query finds a row with words from both Sets 1 and 2, those lines should pasted into Sheet 6.
Set 2
"apple"
"banana"
"orange"


Sheet 6 can only have lines with at least one term from both Sets 1 and 2.

Any and all help is greatly appreciated.

macro tests2.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
11	ID	Must_Pay	Funded	Agency	Directorate_ID	Division_ID	Acq_Package	OS	Amount_Paid	Amount_Owed	Date_Updated	Start_Date	End_Date	Updated_By
12	SDJ4478	yes	no	USMC	J6	CSD	USMC-Package 789	XP	$ 2,000.00	$ 12,000.00	11/15/2021	2/5/2020	2/2/2022	Jane Doe
13	LIU9898	no	yes	USA	J3	CSD	USA-Package 3398J	TTP4 Windows 7 HWLM	$ 3,500.00	$ 6,500.00	3/2/2021	3/1/2021	2/3/2022	John Doe
14	LKJ2147	no	yes	USAF	J3	CSD	USAF-Package 776534	Win XP	$ 2,100.00	$ 3,500.00	7/25/2021	7/5/2021	2/7/2022	Jane Smith
15	POI6698	yes	no	USA	J4	IOD	USA-Package 3398J	win xp	$ 9,800.00	$ 12,000.00	9/2/2021	4/16/2020	2/8/2022	Jane Smith
16	ABCS987	no	no	USAF	J1	SDD	USAF-Package 776534	TTP4 Windows 7 HWLM	$ 7,400.00	$ 8,000.00	6/6/2021	3/1/2021	2/9/2022	Joe Doe
17	SMN3298	no	yes	USSF	S4	CSD	USSF-Package 2312	Windows 7	$ 6,500.00	$ 9,500.00	9/22/2021	7/5/2021	2/10/2022	Joe Doe
18	LMN326	yes	yes	USCG	S2	CSD	USCG-Package 3287	Windows XP	$ 2,100.00	$ 2,500.00	7/9/2021	3/1/2021	2/12/2022	John Doe
19	WDC589	no	yes	USN	S6	CIO	USN-Package 923	Win 7	$ 1,750.00	$ 8,700.00	2/1/2022	11/9/2020	2/13/2022	Jane Doe
20	VFD365	yes	yes	USN	S6	CIO	USN-Package 923	Win xp	$ 630.00	$ 6,500.00	3/6/2021	3/25/2020	2/14/2022	Jane Smith
21	CVF127	yes	yes	USMC	S3	CIO	USMC-Package 789	74BBN win 7 TTP77	$ 2,500.00	$ 3,500.00	12/1/2021	1/6/2021	2/15/2022	Jane Smith
22	CVRF9863	yes	no	USN	J2	SDD	USN-Package 923	windows 7	$ 7,800.00	$ 7,800.00	2/2/2022	9/7/2020	2/16/2022	Jane Smith
23	EWD441	yes	yes	USAF	S4	CSD	USAF-Package 776534	windows XP	$ 1,200.00	$ 4,500.00	8/5/2021	7/7/2020	2/18/2022	John Doe
24	RRB2285	no	no	USAF	S5	CSD	USAF-Package 776534	Windows 7	$ 3,200.00	$ 4,500.00	9/5/2021	9/3/2020	2/19/2022	John Doe
25	SDJ4478	yes	orange	USMC	J6	CSD	USMC-Package 789	XP	$ 2,000.00	$ 12,000.00	11/15/2021	2/5/2020	2/2/2022	Jane Doe
26	LIU9898	no	yes	USA	J3	xyz	USA-Package 3398J	Windows 7	$ 3,500.00	$ 6,500.00	3/2/2021	3/1/2021	2/3/2022	John Doe
27	LKJ2147	no	yes	USAF	J3	CSD	USAF-Package 776534	Win XP	$ 2,100.00	$ 3,500.00	7/25/2021	7/5/2021	2/7/2022	Jane Smith
28	POI6698	yes	apple	USA	J4	IOD	USA-Package 3398J	win xp	$ 9,800.00	$ 12,000.00	9/2/2021	4/16/2020	2/8/2022	Jane Smith
29	ABCS987	no	no	abc	J1	SDD	USAF-Package 776534	Windows 7	$ 7,400.00	$ 8,000.00	6/6/2021	3/1/2021	2/9/2022	Joe Doe
30	SMN3298	no	yes	USSF	S4	CSD	USSF-Package 2312	Windows 7	$ 6,500.00	$ 9,500.00	9/22/2021	7/5/2021	2/10/2022	Joe Doe
31	LMN326	yes	apple	abc	S2	CSD	USCG-Package 3287	Windows XP	$ 2,100.00	$ 2,500.00	7/9/2021	3/1/2021	2/12/2022	John Doe
32	WDC589	no		USN	S6	def	USN-Package 923	74BBN Win 7 TTP77	$ 1,750.00	$ 8,700.00	2/1/2022	11/9/2020	2/13/2022	Jane Doe
33	VFD365	yes	yes	USN	S6	xyz	USN-Package 923	Win xp	$ 630.00	$ 6,500.00	3/6/2021	3/25/2020	2/14/2022	Jane Smith
34	CVF127	yes	apple	abc	S3	xyz	USMC-Package 789	win 7	$ 2,500.00	$ 3,500.00	12/1/2021	1/6/2021	2/15/2022	Jane Smith
35	CVRF9863	yes	no	USN	J2	SDD	USN-Package 923	windows 7	$ 7,800.00	$ 7,800.00	2/2/2022	9/7/2020	2/16/2022	Jane Smith
36	EWD441	yes	yes	USAF	S4	CSD	USAF-Package 776534	windows XP	$ 1,200.00	$ 4,500.00	8/5/2021	7/7/2020	2/18/2022	John Doe
37	RRB2285	no	no	def	S5	CSD	USAF-Package 776534	Windows 7	$ 3,200.00	$ 4,500.00	9/5/2021	9/3/2020	2/19/2022	John Doe
Sheet3

 

[gravanoc]

Is it intended to duplicate the results when there's a match in both sets, since that rule is in both macros?

 

[JoeDelcambre]

Well, I'll create 3 more sheets for the results. Sheets 4, 5, and 6. So, anything with only Set 1 terms would go in Sheet 4, results with only Set 2 goes in Sheet 5, and if the results return keywords from both Sets 1 and 2, it would get pasted into Sheet 6.

 

[gravanoc]

I am partially finished, but let me know if this is on the right track or not:

Option Explicit

Sub SetFinder()

    Dim rngMain As Range, rngSht4 As Range
    Dim rngSht5 As Range, rngSht6 As Range
    Dim rngUnion As Range
    
    Dim i As Long, j As Long
    Dim setA As String, setB As String
    Dim bSetA As Boolean, bSetB As Boolean
    
    Set rngMain = Sheet3.Range("A2:N2")
    Set rngSht4 = Sheet4.Range("B2")
    Set rngSht5 = Sheet5.Range("B2")
    Set rngSht6 = Sheet6.Range("B2")

    setA = "abc, def, xyz"
    setB = "apple, banana, orange"
    
    For i = 0 To Sheet3.Range("A1048576").End(xlUp).Row - 2
        
        Set rngUnion = Nothing
        bSetA = False: bSetB = False
        For j = 0 To rngMain.Cells.Count - 1
        
            If InStr(1, setA, rngMain.Cells(i + 1, j + 1).Value) > 0 Then
                Set rngUnion = CheckRange(rngUnion, rngMain.Cells(i + 1, j + 1))
                bSetA = True
            End If
            
            If InStr(1, setB, rngMain.Cells(i + 1, j + 1).Value) > 0 Then
                Set rngUnion = CheckRange(rngUnion, rngMain.Cells(i + 1, j + 1))
                bSetB = True
            End If
            
        Next j
        
        If (bSetA And bSetB) Then
            
            If Not IsEmpty(rngSht6.Value) Then _
                Set rngSht6 = Sheet6.Range("B1048576").End(xlUp).Offset(1)
            rngSht6.Value = rngUnion.Value
            
        ElseIf bSetA Then
        
            If Not IsEmpty(rngSht4.Value) Then _
                Set rngSht4 = Sheet4.Range("B1048576").End(xlUp).Offset(1)
            rngSht4.Value = rngUnion.Value
        
        ElseIf bSetB Then
        
            If Not IsEmpty(rngSht5.Value) Then _
                Set rngSht5 = Sheet5.Range("B1048576").End(xlUp).Offset(1)
            rngSht5.Value = rngUnion.Value
        
        End If
        
    Next i

End Sub

Function CheckRange(rngUnion As Range, rngMain As Range) As Range
    
    Dim combRng As Range
    
    If rngUnion Is Nothing Then
        Set combRng = rngMain
    ElseIf Intersect(rngUnion, rngMain) Is Nothing Then
        Set combRng = Union(rngUnion, rngMain)
    Else
        Set combRng = rngUnion
    End If

    Set CheckRange = combRng
    
End Function

 

[gravanoc]

One thing I need clarification on is whether the entire row needs to be pasted or just the cell containing the text of a set. Currently it's just pasting the matched cell's contents. I put the results for each Sheet 4 - 6 in cell B2 on down.

 

[JoeDelcambre]

One thing I need clarification on is whether the entire row needs to be pasted or just the cell containing the text of a set. Currently it's just pasting the matched cell's contents. I put the results for each Sheet 4 - 6 in cell B2 on down.

Sorry, I just saw this message. I would need the entire row pasted onto the new sheet.