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

Kerryx

Board Regular
Joined
May 6, 2016
Messages
101
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
ABCDEFGH
1ItemCodeDescriptionCode2PicGroupLnComponentDescription 2
220385011MasterGroupMS1M1090112011Master Recipe Code 1
390112011Master RecipeMR11M1020111111Ing 1
490112011Master RecipeMR11M2020222222Ing 2
590112011Master RecipeMR11M3020333333Ing 3
690112011Master RecipeMR11M4020444444Ing 4
720385022MasterGroupMS1M1090112022Master Recipe Code 2
890112022Master recipeMR21M1020555555Ing 1
990112022Master recipeMR21M2020666666Ing 2
1090112022Master recipeMR21M3020777777Ing 3
1190112022Master recipeMR21M4020888888Ing 4
1290112022Master recipeMR21M5090332023Ing 4
1390332023Master recipeMR31M1020999999Ing 1
1490332023Master recipeMR31M1020666666Ing 2
1520385023MasterGroupMS1M1090112033Master Recipe Code 3
1690112033Master recipeMR41M1090112011Ing 1
1790112033Master recipeMR41M2090112022Ing 2
1890112033Master recipeMR41M3020999999Ing 3
1990112033Master RecipeMR41M4020444444Ing 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
ABCDEFGH
1ItemCodeDescriptionCode2PicGroupLnComponentDescription 2
220385011MasterGroupMS1M1090112011Master Recipe Code 1
Sheet2

Then search through (Col G) to find all rows with 90112011
Test190120.xlsm
ABCDEFGH
1ItemCodeDescriptionCode2PicGroupLnComponentDescription 2
220385011MasterGroupMS1M1090112011Master Recipe Code 1
390112011Master RecipeMR11M1020111111Ing 1
490112011Master RecipeMR11M2020222222Ing 2
590112011Master RecipeMR11M3020333333Ing 3
690112011Master RecipeMR11M4020444444Ing 4
Sheet2


A more complex one where youo have multiple master recipe components
Test190120.xlsm
ABCDEFGH
1ItemCodeDescriptionCode2PicGroupLnComponentDescription 2
220385023MasterGroupMS1M1090112033Master Recipe Code 3
390112033Master recipeMR41M1090112011Ing 1
490112033Master recipeMR41M2090112022Ing 2
590112033Master recipeMR41M3020999999Ing 3
690112033Master RecipeMR41M4020444444Ing 4
790112011Master RecipeMR11M1020111111Ing 1
890112011Master RecipeMR11M2020222222Ing 2
990112011Master RecipeMR11M3020333333Ing 3
1090112011Master RecipeMR11M4020444444Ing 4
1190112022Master recipeMR21M1020555555Ing 1
1290112022Master recipeMR21M2020666666Ing 2
1390112022Master recipeMR21M3020777777Ing 3
1490112022Master recipeMR21M4020888888Ing 4
1590112022Master recipeMR21M5090332023Ing 4
1690332023Master recipeMR31M1020999999Ing 1
1790332023Master recipeMR31M1020666666Ing 2
Sheet2

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

VBA Code:
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
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Watch MrExcel Video

Forum statistics

Threads
1,127,172
Messages
5,623,178
Members
415,955
Latest member
Footballtend

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top