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

AssetID	name	source	Title
AAA	name 1	source 1	Title 1
BCBC	name 2	source 2	Title 2

<tbody>
</tbody>

Example of sheet 2

ParentID ChildID AAA 10101 AAA 10102 AAA 10103 AAA 10104 AAA 10105 AAA 10106 AAA 10107 AAA 10108 BCBC 22888 BCBC 22889 BCBC 22890 <tbody> </tbody>

<tbody>
</tbody>

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.

AssetID	name	source	Title
AAA	name 1	source 1	Title 1
10101	name 1	source 1	Title 1
10102	name 1	source 1	Title 1
10103	name 1	source 1	Title 1
10104	name 1	source 1	Title 1
10105	name 1	source 1	Title 1
10106	name 1	source 1	Title 1
10107	name 1	source 1	Title 1
10108	name 1	source 1	Title 1
BCBC	name 2	source 2	Title 2
22888	name 2	source 2	Title 2
22889	name 2	source 2	Title 2
22890	name 2	source 2	Title 2

<tbody>
</tbody>

 

[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!