loop through values in a column and return all rows appended onto original extract

[Kerryx]

Hi All, Currently got this far, use the code below to get to step one which is to find the row in sheet 1(colA) that contains the rows with the same ItemCode as i entered in the text box and copies this line or lines to Sheet2 .
The part i am having trouble with is that now that i have the row in sheet 2 i need to have another bit of vba to check the values in Column G(Components) and check if any components starts with the number "9" (this is the Master Recipe), find those lines( in Sheet1, Col A) and append them to the row that was copied to Sheet 2 already.
To add to the confusion a Master Recipe could also be a component( a subrecipe) in the recipe so need to loop back though the column again to check until all have Master Recipe been copied and appended to Sheet2, if that makes sense.

Test190120.xlsm
	A	B	C	D	E	F	G	H
1	ItemCode	Description	Code2	Pic	Group	Ln	Component	Description 2
2	20385011	MasterGroup	MS	1	M	10	90112011	Master Recipe Code 1
3	90112011	Master Recipe	MR1	1	M	10	20111111	Ing 1
4	90112011	Master Recipe	MR1	1	M	20	20222222	Ing 2
5	90112011	Master Recipe	MR1	1	M	30	20333333	Ing 3
6	90112011	Master Recipe	MR1	1	M	40	20444444	Ing 4
7	20385022	MasterGroup	MS	1	M	10	90112022	Master Recipe Code 2
8	90112022	Master recipe	MR2	1	M	10	20555555	Ing 1
9	90112022	Master recipe	MR2	1	M	20	20666666	Ing 2
10	90112022	Master recipe	MR2	1	M	30	20777777	Ing 3
11	90112022	Master recipe	MR2	1	M	40	20888888	Ing 4
12	90112022	Master recipe	MR2	1	M	50	90332023	Ing 4
13	90332023	Master recipe	MR3	1	M	10	20999999	Ing 1
14	90332023	Master recipe	MR3	1	M	10	20666666	Ing 2
15	20385023	MasterGroup	MS	1	M	10	90112033	Master Recipe Code 3
16	90112033	Master recipe	MR4	1	M	10	90112011	Ing 1
17	90112033	Master recipe	MR4	1	M	20	90112022	Ing 2
18	90112033	Master recipe	MR4	1	M	30	20999999	Ing 3
19	90112033	Master Recipe	MR4	1	M	40	20444444	Ing 4
Sheet1

For example what i need to return are for a simple one this
Enter 20385011 pulls back line 2 the row with the components (Col G)

Test190120.xlsm
	A	B	C	D	E	F	G	H
1	ItemCode	Description	Code2	Pic	Group	Ln	Component	Description 2
2	20385011	MasterGroup	MS	1	M	10	90112011	Master Recipe Code 1
Sheet2

Then search through (Col G) to find all rows with 90112011

Test190120.xlsm
	A	B	C	D	E	F	G	H
1	ItemCode	Description	Code2	Pic	Group	Ln	Component	Description 2
2	20385011	MasterGroup	MS	1	M	10	90112011	Master Recipe Code 1
3	90112011	Master Recipe	MR1	1	M	10	20111111	Ing 1
4	90112011	Master Recipe	MR1	1	M	20	20222222	Ing 2
5	90112011	Master Recipe	MR1	1	M	30	20333333	Ing 3
6	90112011	Master Recipe	MR1	1	M	40	20444444	Ing 4
Sheet2

A more complex one where youo have multiple master recipe components

Test190120.xlsm
	A	B	C	D	E	F	G	H
1	ItemCode	Description	Code2	Pic	Group	Ln	Component	Description 2
2	20385023	MasterGroup	MS	1	M	10	90112033	Master Recipe Code 3
3	90112033	Master recipe	MR4	1	M	10	90112011	Ing 1
4	90112033	Master recipe	MR4	1	M	20	90112022	Ing 2
5	90112033	Master recipe	MR4	1	M	30	20999999	Ing 3
6	90112033	Master Recipe	MR4	1	M	40	20444444	Ing 4
7	90112011	Master Recipe	MR1	1	M	10	20111111	Ing 1
8	90112011	Master Recipe	MR1	1	M	20	20222222	Ing 2
9	90112011	Master Recipe	MR1	1	M	30	20333333	Ing 3
10	90112011	Master Recipe	MR1	1	M	40	20444444	Ing 4
11	90112022	Master recipe	MR2	1	M	10	20555555	Ing 1
12	90112022	Master recipe	MR2	1	M	20	20666666	Ing 2
13	90112022	Master recipe	MR2	1	M	30	20777777	Ing 3
14	90112022	Master recipe	MR2	1	M	40	20888888	Ing 4
15	90112022	Master recipe	MR2	1	M	50	90332023	Ing 4
16	90332023	Master recipe	MR3	1	M	10	20999999	Ing 1
17	90332023	Master recipe	MR3	1	M	10	20666666	Ing 2
Sheet2

Obviously you cant have it looping forever so any help appreciated.

Sub Extract()
'Sheets("sheet2").UsedRange.ClearContents
Sheets("sheet2").Rows("2:" & Sheets("sheet2").Rows.Count).ClearContents
Dim LCopyToRow As Integer
'On Error GoTo Err_Execute
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
Dim sheetTarget As String: sheetTarget = "sheet2"
Dim sheetToSearch As String: sheetToSearch = "sheet1"
'Value to search for
findstring = InputBox("Enter a Search value")
Dim targetValue As String: targetValue = findstring
Dim columnToSearch As String: columnToSearch = "A"
Dim iniRowToSearch As Integer: iniRowToSearch = 2
Dim LSearchRow As Long 'As far as it is not clear the number of rows you will be considering, better relying on the long type
Dim maxRowToSearch As Long: maxRowToSearch = 20000 'There are lots of rows, so better setting a max. limit
If Trim(findstring) <> "" Then
    For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count
        'If value in the current row (in columnToSearch in sheetToSearch) equals targetValue, copy entire row to LCopyToRow in sheetTarget
        If Sheets(sheetToSearch).Range(columnToSearch & CStr(LSearchRow)).Value = targetValue Then
            'Select row in Sheet1 to copy
            Sheets(sheetToSearch).Rows(LSearchRow).Copy
            'Paste row into Sheet2 in next row
            Sheets(sheetTarget).Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
        End If
        If (LSearchRow >= maxRowToSearch) Then
            Exit For
        End If
    Next LSearchRow
    'Position on cell A1
    Application.CutCopyMode = False
    Range("A1").Select
    MsgBox "All matching data has been copied."
End If
End Sub

 

[Kerryx]

just a bump to see if anyone can help