Hello Everyone,

I've been able to find great advices numerous times before in this forum, but this is the first time I couldn't find an answer to a new problem. My apologies if this has been answered before but hopefully someone can point me in the right direction.


I have 3 worksheets:
1. Sheet1 is a huge Data Set with values starting from column A10 to I10. A10 to I10 is the header.
2. Sheet2 is blank with headers on row 1.
3. Sheet3 is a list of keywords under column A.

My goal is create a macro that will look at each of the keywords listed in Sheet3 and search for them in Column B and Column D of Sheet1. The keywords may appear in either Column B or Column D in Sheet1. For each row it finds, I need it to copy the entire row to Sheet2 starting on row 2 since row 1 has headers.

What I'm able to get so far is just searching under one column only instead of searching across two columns.

I hope my explanation isn't too confusing and I thank you in advance. I've attached a sample of the file with mock data and posted the VBA I've been using so far to search under one column.

Any help?

DataSample.xlsx

  
Sub SearchText()
     
    Dim OutSH As Worksheet, CodeSH As Worksheet
    Set OutSH = Sheets("Sheet2")
    Set CodeSH = Sheets("Sheet3")
          
    With OutSH
    Range(.Range("A1"), .UsedRange).Offset(1, 0).ClearContents
End With
     
    For Each ce In CodeSH.Range("A1:A" & CodeSH.Cells(Rows.Count, 1).End(xlUp).Row)
        With Sheets("Sheet1")
            For I = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
                 
                Set findit = .Cells(I, 2).Find(What:=ce.Value, LookAt:=xlPart)
                If Not findit Is Nothing Then
                    .Cells(I, 1).EntireRow.Copy Destination:=OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                End If
                 
            Next I
        End With
    Next ce
End Sub