# Parent - Child Hierarchy

#### Kingsley MG

##### New Member
Data as below
 Parent Child AAA BBB BBB CCC AAA DDD DDD EEE EEE FFF CCC GGG GGG HHH HHH III III JJJ III KKK JJJ LLL KKK MMM MMM NNN

<tbody>
</tbody>
and continues.

Output should be collapsed. EX. as below
 AAA + BBB + CCC + GGG + HHH + III + JJJ + LLL + KKK + MMM + NNN + DDD + EEE + FFF

<tbody>
</tbody>
and continue as per the Parent - Child data.

#### Fazza

##### MrExcel MVP
hello. suggest you test it on further data, & modify as required if you find errors/deficiencies. cheers
Code:
``````Sub maybe()
'https://www.mrexcel.com/forum/excel-questions/1066730-parent-child-hierarchy.html

'CODING ASSUMES input data is on worksheet called "input data" & results go to worksheet "output"

Dim i As Long
Dim lColumn As Long
Dim sThisChild As String
Dim sThisParent As String
Dim rng As Excel.Range
Dim ar As Variant

ar = Worksheets("input data").Range("A1").CurrentRegion.Value2

With Worksheets("output")
.Cells.Clear
'Put first data in worksheet, from row 2 of input data
.Cells(1, 1).Value2 = ar(2, 1)
.Cells(2, 1).Value2 = "+"
.Cells(2, 2).Value2 = ar(2, 2)

'Now loop through all others
For i = LBound(ar, 1) + 2 To UBound(ar, 1)
sThisParent = ar(i, 1)
sThisChild = ar(i, 2)

'check if the parent is already in the worksheet
Set rng = .Cells.Find(What:=sThisParent, LookAt:=xlWhole)

If rng Is Nothing Then
'Parent data is not yet on the worksheet.
'This new data can be posted to the worksheet's first row or become the new last row.
'Make it the last row for consistency with image posted in question.
'Work out the current last row,
Set rng = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
.Cells(rng.Row + 1, 1) = sThisParent
.Cells(rng.Row + 2, 1).Value2 = "+"
.Cells(rng.Row + 2, 2) = sThisChild
Else
'Parent data is already on the worksheet. So add this data as a child to it.
'if there is not yet a child,
If Len(rng.Offset(1, 1).Value2) = 0 Then
rng.Offset(1).EntireRow.Insert
rng.Offset(1).Value2 = "+"
rng.Offset(1, 1).Value2 = sThisChild
Else
'find end of this branch
lColumn = rng.Column
Do
Set rng = rng.Offset(1, 1)
Loop Until Len(rng.Offset(1, 1).Value2) = 0
rng.Offset(1).EntireRow.Insert
.Cells(rng.Row + 1, lColumn).Value2 = "+"
.Cells(rng.Row + 1, lColumn + 1).Value2 = sThisChild
End If
End If

Next i
End With

End Sub``````