Vba to find items and place on new sheet.

[tscherf]

Hoping I can get some help on this. I have two sheets in my workbook, Sheet 1(Main) and sheet2(parent/child) sheet 1(main) consist of a list of parent items# . These items are complete items already built. Desk, Chair.. example, item# ec-72-36.. can be a Desk on sheet 1(main) on sheet2 , There is a reference to these parent items broken down into their child number and quantity of each child # it takes to build this complete parent item. Sheet 2(parent/child) A(Parent #) B(Child item#
c(Quantity). ie..
•parent | child | qnty
•ec-72-36 | b36-1 | 2
•ec-72-36 | g3657 | 1
•w48-67-1| w=456| 4
•W48=67-1|l-r567| 3
•
•
so on
In the Parent Colum it could have 10 item# with different child information.

Was looking for a way to go each cell value in sheet 1 (Main), look for those parent # in the sheet2(parent/child) if it finds those items copy the child items along with its quantity, then paste those items in a new sheet sheet 3.
I have a large amount of parent items, so would like to separate these in the new sheet 3 in like a tree format. ie,

•..parent ID
•............child ID ....quantity
•............Child ID ....quantity
•..parent ID
•............child ID ....quantity
•............Child ID ....quantity


I've been working on this for couple days with many trails and error along with loop trapping myself. I will post some of my messy work and sorry if its a mess, but I was experimenting than going other directions, Thank you for all the help I get. its been a lot of hair pulling.
Tim

Dim FindString As String
Dim Rng As Range
Dim parent As String
Dim Child As String
Dim LastCell As Long

For Each cell In Worksheets("Main").Range("E6:E8000")
    FindString = cell.Value

    If Trim(FindString) <> "STOP" Then

        With sheets("parentchild").Range("A:A")

'Set Rng = Cells.find(what:=FindString, after:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
   ' Cells.FindNext(after:=ActiveCell).Activate

Set Rng = .find(what:=FindString) ', _
                            after:=.ActiveCell, _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

              'Set Rng = .find(what:=FindString, _
                            after:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)



            If Not Rng Is Nothing Then

                Application.Goto Rng, True

                parent = ActiveCell.Offset(0, 0).Value
                Child = ActiveCell.Offset(0, 2).Value
sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = parent
sheets("Sheet4").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Child
'.FindNext(after:=ActiveCell).Activate
            Else
              Exit Sub
            End If
        End With
    End If

Next



 'Cells.find(what:="BE454M-SIL", after:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    'Cells.FindNext(after:=ActiveCell).Activate
End Sub
Sub f3()
Dim i As Integer
Dim l As Integer

Dim findvalue As String
Dim found As String
Dim FindString As String
Dim parent As String
Dim Child As String
 
'i = 6
'l = 1

'Do Until i > 10


    For Each cell In Worksheets("Main").Range("E6:E5000")
    FindString = cell.Value
    
    If FindString = "Stop" Then
    Exit Sub
    End If
    
    
    Do Until lcell = "STOP"
    
    For Each lcell In sheets("parentchild").Range("A:A")
  found = lcell.Value
  
  If FindString = found Then
  
  'With sheets("parentchild")
  
              parent = ActiveCell.Offset(0, 0).Value
              Child = ActiveCell.Offset(0, 2).Value
              sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = parent
             sheets("Sheet4").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Child
             
       End If
        Next lcell
        Loop
        'End If
        
        'If parent = "Stop" Then
        Next cell
        'End If
 
  
  
  
  
 ' Next cell
'Do Until sheets("parentchild").Range("A1:A1000")
       ' With sheets("parentchild").Range("A:A")
        '    found = Cells(l, 1).Value
         '       If FindString = found Then
          '          parent = ActiveCell.Offset(0, 0).Value
           '         Child = ActiveCell.Offset(0, 2).Value
            '        sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = parent
             '       sheets("Sheet4").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Child
           
          'l = l + 1
          
         ' Else
          ' i = i + 1
           
           '       End If
                 
            ' End With
 
  
    
   '  i = i + 1
'Loop


End Sub