Find all children of the parent in sheet 2 and insert rows below the parent in sheet 1

[cindygo]

We have a manual process that we want to automate. I’m hoping someone can advise on how to do this with a macro? I haven’t been successful in figuring out how to make this work. Thank you in advance for any help on this, Cindy

Currently using Excel 2010

On a daily bases we receive an excel workbook with two tabs:

1. Sheet 1 and its columns
   1. AssetID
   2. Name
   3. Source
   4. Title
2. Sheet 2 and its columns. Relationship list
   1. ParentID = AssetID in sheet 1
   2. ChildID

In sheet 1 the AssetID is unique. In sheet 2 the ParentID will be listed as many times as the number of children of that ParentID, meaning each parent may have 1 or many children. It is never the same.

Example of sheet 1
[TABLE="width: 675"]
<tbody>[TR]
[TD]AssetID
[/TD]
[TD]name
[/TD]
[TD]source
[/TD]
[TD]Title
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]BCBC
[/TD]
[TD]name 2
[/TD]
[TD]source 2
[/TD]
[TD]Title 2
[/TD]
[/TR]
</tbody>[/TABLE]

Example of sheet 2
[TABLE="width: 335"]
<tbody>[TR]
[TD][TABLE="width: 192"]
<tbody>[TR]
[TD]ParentID
[/TD]
[TD]ChildID
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]10101
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]10102
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]10103
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]10104
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]10105
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]10106
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]10107
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]10108
[/TD]
[/TR]
[TR]
[TD]BCBC
[/TD]
[TD]22888
[/TD]
[/TR]
[TR]
[TD]BCBC
[/TD]
[TD]22889
[/TD]
[/TR]
[TR]
[TD]BCBC
[/TD]
[TD]22890
[/TD]
[/TR]
</tbody>[/TABLE]

[/TD]
[TD]
[/TD]
[/TR]
</tbody>[/TABLE]

Currently we manually copy and paste the children from sheet 2 and insert them below their matching parent Asset. This moves all the cells down to accommodate for the children. We then copy and paste the data from the matching parent, name, source and title into the children cells. The below is the end result.

[TABLE="width: 675"]
<tbody>[TR]
[TD]AssetID
[/TD]
[TD]name
[/TD]
[TD]source
[/TD]
[TD]Title
[/TD]
[/TR]
[TR]
[TD]AAA
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]10101
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]10102
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]10103
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]10104
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]10105
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]10106
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]10107
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]10108
[/TD]
[TD]name 1
[/TD]
[TD]source 1
[/TD]
[TD]Title 1
[/TD]
[/TR]
[TR]
[TD]BCBC
[/TD]
[TD]name 2
[/TD]
[TD]source 2
[/TD]
[TD]Title 2
[/TD]
[/TR]
[TR]
[TD]22888
[/TD]
[TD]name 2
[/TD]
[TD]source 2
[/TD]
[TD]Title 2
[/TD]
[/TR]
[TR]
[TD]22889
[/TD]
[TD]name 2
[/TD]
[TD]source 2
[/TD]
[TD]Title 2
[/TD]
[/TR]
[TR]
[TD]22890
[/TD]
[TD]name 2
[/TD]
[TD]source 2
[/TD]
[TD]Title 2
[/TD]
[/TR]
</tbody>[/TABLE]

 

[AlphaFrog]

Try this...

[color=darkblue]Sub[/color] Families()
    [color=darkblue]Dim[/color] ws1 [color=darkblue]As[/color] Worksheet, ws2 [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color], rngParent [color=darkblue]As[/color] Range
    [color=darkblue]Set[/color] ws1 = Sheets("Sheet1")
    [color=darkblue]Set[/color] ws2 = Sheets("Sheet2")
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]For[/color] i = ws1.Range("A" & Rows.Count).End(xlUp).Row [color=darkblue]To[/color] 2 [color=darkblue]Step[/color] -1
        [color=darkblue]Set[/color] rngParent = ws1.Range("A" & i)
        [color=darkblue]If[/color] WorksheetFunction.CountIf(ws2.Range("A:A"), rngParent.Value) > 0 [color=darkblue]Then[/color]
            ws2.Range("A:A").AutoFilter Field:=1, Criteria1:=rngParent
            [color=darkblue]With[/color] ws2.Range("A2", ws2.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
                rngParent.Offset(1).Resize(.Count).EntireRow.Insert
                rngParent.EntireRow.Copy Destination:=rngParent.Offset(1).Resize(.Count).EntireRow
                .Offset(, 1).Copy Destination:=rngParent.Offset(1)
            [color=darkblue]End[/color] [color=darkblue]With[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i
    ws2.AutoFilterMode = [color=darkblue]False[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[cindygo]

AlphaFrog that worked perfectly! Thank you so much. You saved us a lot of time!