Key Word Search Loop

Hi,

I am running a project on a big database of customers which require the following:
Step 1 - Search for a keyword (Worksheet = Search, B4) through various columns (Workseet = Data, Column B, F, J)
Step 2 - If the keyword is found in any column, copy and past that whole line on another sheet ("Worksheet II")

I was able to do step 1 and 2 with a small macro and some clever excel formulas (see Name_Search macro). Now I have to repeat these steps multiple times for various keywords. Please will you assist in building the code to do the following?

Step 3 - Given an array of multiple keywords (Worksheet = Search, B8 downwards), run Step 1 and Step 2 for each keyword but copy their associated "Possible TP Codes"and "Possible TP Names" in the columns provide in "Worksheet II".

Please find attached a model example.

Sub Name_Search()

Sheets("Worksheet II").Select
Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Range("array_data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("criteria_name"), CopyToRange:=Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0), Unique:=False

End Sub

"Worksheet II" in the workbook you provided is completely blank.

Hi stnkynts,

"Worksheet II" gets populated when you run the Name_Search macro for each keyword search.

So you run your Name_Search macro which populates "Worksheet II". I'm okay up to here, but then I get lost as to your process. You say you want to copy the associated "Possible TP Codes"and "Possible TP Names" in the "Search" worksheet cell B8 downwards, based upon keyword, but "Worksheet II" at this point does not have any values in the column titled keyword (column M).

Or maybe do you want to find your keyword in B4, search B8 downwards and copy those 3 cells to some cells in "Worksheet II". This leaves a question as to the addition of more rows over time which will be populated.....a ton of questions here.

If it was me I would just rewrite the whole thing to do it in one macro rather than have separate events. I however can't seem to understand your whole flow so I am at a crossroads.

Hi stnkynts,

Customer hierarchies ("CIF Customer Name " at the lowest level, then "Immediate Parent Name" & "Top Parent Name" at the highest level) are managed manually by our organisation. I have to search through a big database to find entities that might belong to a "Top Parent" and send it off to colleagues to verify.

My manual process for "Berry Group" begins by searching for keywords in multiple columns. I then manually copy and paste the "keyword, the "Possible TP Code" and "Possible TP Name" to give colleagues some guidance. They reply by confirming the update at which point I will add the "CIF Customer Name" to the top parent in question.

I’ve added a few notes to my spreadsheet to assist clarifying the manual process and hope that you can help me to automate it. "Required Worksheet II" shows the final product for the 3 line items used as examples.

Well at least let me take a stab in the dark. All in one

Sub Name_Search()
Dim ws1 As Worksheet:   Set ws1 = Sheets("Search")
Dim ws2 As Worksheet:   Set ws2 = Sheets("Data")
Dim ws3 As Worksheet:   Set ws3 = Sheets("Worksheet II")
Dim myRange As Range
Dim LR1 As Long, iCount As Long, iMax As Long

LR1 = ws1.Range("B" & Rows.Count).End(xlUp).Row

Range("array_data").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("criteria_name"), CopyToRange:=ws3.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0), Unique:=False
Set myRange = ws1.Range("B8:B" & LR1).Find(what:=ws1.Range("B4").Value, LookIn:=xlValues, LookAt:=xlWhole)
iMax = ws3.Range("A" & Rows.Count).End(xlUp).Row - ws3.Range("M" & Rows.Count).End(xlUp).Row
    If Not myRange Is Nothing Then
        For iCount = 1 To iMax
            myRange.Resize(1, 3).Copy Destination:=ws3.Range("M" & Rows.Count).End(xlUp).Offset(1, 0)
        Next iCount
    End If
    
End Sub

Hi stnkynts,

Your code did the trick - thank you very much!