How to create parent-child data table in excel?

Question

I have data like this:

Parent | Data --------------- Root | AAA AAA | BBB AAA | CCC AAA | DDD BBB | EEE BBB | FFF CCC | GGG DDD | HHH 

Which should be converted to a similar style below. This should basically end in an Excel spreadsheet. How to convert the above data to the following:

Levels

 1 | 2 | 3 AAA | BBB | AAA | BBB | EEE AAA | BBB | FFF AAA | CCC | AAA | CCC | GGG AAA | DDD | AAA | DDD | HHH 

Answer 1

I started and finished the answer below late at night. In the cold light of the day he needs at least some expansion.

Sheet2, source data, before running the macro:

Sheet3, the result, after running the macro:

The method is based on the creation of arrays connecting each child with his parent. Then the macro follows the chain from each child up its ancestors, building a line: child, parent | child, grandparent | parent | child, ... After sorting, this is a result that is ready to be saved.

In the sample data, steps 1 and 3 can be combined because all names and strings are in alphabetical order. Building a list of names in one step and linking them to another makes a simple macro independent of the sequence. In reflection, I'm not sure if the second step is needed, sorting the names. You need to sort the lists of names obtained using titanium, step 5. Sorting Sheet3 after the release is impossible, because there can be more than three levels.

---

I'm not sure if this is considered an elegant solution, but rather simple.

I placed the source data on sheet sheet Sheet2, and I exit Sheet3.

There are 7 steps:

• Assembling an array of a Child containing all the names.
• Sort the array Child. I have provided a simple view sufficient for demonstration. Better varieties are available online if you have enough names to require it.
• Create an array of Parent so that Parent (N) is an index in Child from the parent element of Child (N).
• Create an array of ParentName following the pointers in the array. From parent to parent to grandparents ... In doing so, determine the maximum number of levels.
• Sort the ParentName array.
• Create a title bar in the output sheet.
• Copy the name of the parent to the output sheet.

I believe that I have added enough comments to make the code clear.

 Option Explicit Sub CreateParentChildSheet() Dim Child() As String Dim ChildCrnt As String Dim InxChildCrnt As Long Dim InxChildMax As Long Dim InxParentCrnt As Long Dim LevelCrnt As Long Dim LevelMax As Long Dim Parent() As Long Dim ParentName() As String Dim ParentNameCrnt As String Dim ParentSplit() As String Dim RowCrnt As Long Dim RowLast As Long With Worksheets("Sheet2") RowLast = .Cells(Rows.Count, 1).End(xlUp).Row ' If row 1 contains column headings, if every child has one parent ' and the ultimate ancester is recorded as having a parent of "Root", ' there will be one child per row ReDim Child(1 To RowLast - 1) InxChildMax = 0 For RowCrnt = 2 To RowLast ChildCrnt = .Cells(RowCrnt, 1).Value If LCase(ChildCrnt) <> "root" Then Call AddKeyToArray(Child, ChildCrnt, InxChildMax) End If ChildCrnt = .Cells(RowCrnt, 2).Value If LCase(ChildCrnt) <> "root" Then Call AddKeyToArray(Child, ChildCrnt, InxChildMax) End If Next ' If this is not true, one of the assumptions about the ' child-parent table is false Debug.Assert InxChildMax = UBound(Child) Call SimpleSort(Child) ' Child() now contains every child plus the root in ' ascending sequence. ' Record parent of each child ReDim Parent(1 To UBound(Child)) For RowCrnt = 2 To RowLast If LCase(.Cells(RowCrnt, 1).Value) = "root" Then ' This child has no parent Parent(InxForKey(Child, .Cells(RowCrnt, 2).Value)) = 0 Else ' Record parent for child Parent(InxForKey(Child, .Cells(RowCrnt, 2).Value)) = _ InxForKey(Child, .Cells(RowCrnt, 1).Value) End If Next End With ' Build parent chain for each child and store in ParentName ReDim ParentName(1 To UBound(Child)) LevelMax = 1 For InxChildCrnt = 1 To UBound(Child) ParentNameCrnt = Child(InxChildCrnt) InxParentCrnt = Parent(InxChildCrnt) LevelCrnt = 1 Do While InxParentCrnt <> 0 ParentNameCrnt = Child(InxParentCrnt) & "|" & ParentNameCrnt InxParentCrnt = Parent(InxParentCrnt) LevelCrnt = LevelCrnt + 1 Loop ParentName(InxChildCrnt) = ParentNameCrnt If LevelCrnt > LevelMax Then LevelMax = LevelCrnt End If Next Call SimpleSort(ParentName) With Worksheets("Sheet3") For LevelCrnt = 1 To LevelMax .Cells(1, LevelCrnt) = "Level " & LevelCrnt Next ' Ignore entry 1 in ParentName() which is for the root For InxChildCrnt = 2 To UBound(Child) ParentSplit = Split(ParentName(InxChildCrnt), "|") For InxParentCrnt = 0 To UBound(ParentSplit) .Cells(InxChildCrnt, InxParentCrnt + 1).Value = _ ParentSplit(InxParentCrnt) Next Next End With End Sub Sub AddKeyToArray(ByRef Tgt() As String, ByVal Key As String, _ ByRef InxTgtMax As Long) ' Add Key to Tgt if it is not already there. Dim InxTgtCrnt As Long For InxTgtCrnt = LBound(Tgt) To InxTgtMax If Tgt(InxTgtCrnt) = Key Then ' Key already in array Exit Sub End If Next ' If get here, Key has not been found InxTgtMax = InxTgtMax + 1 If InxTgtMax <= UBound(Tgt) Then ' There is room for Key Tgt(InxTgtMax) = Key End If End Sub Function InxForKey(ByRef Tgt() As String, ByVal Key As String) As Long ' Return index entry for Key within Tgt Dim InxTgtCrnt As Long For InxTgtCrnt = LBound(Tgt) To UBound(Tgt) If Tgt(InxTgtCrnt) = Key Then InxForKey = InxTgtCrnt Exit Function End If Next Debug.Assert False ' Error End Function Sub SimpleSort(ByRef Tgt() As String) ' On return, the entries in Tgt are in ascending order. ' This sort is adequate to demonstrate the creation of a parent-child table ' but much better sorts are available if you google for "vba sort array". Dim InxTgtCrnt As Long Dim TempStg As String InxTgtCrnt = LBound(Tgt) + 1 Do While InxTgtCrnt <= UBound(Tgt) If Tgt(InxTgtCrnt - 1) > Tgt(InxTgtCrnt) Then ' The current entry belongs before the previous entry TempStg = Tgt(InxTgtCrnt - 1) Tgt(InxTgtCrnt - 1) = Tgt(InxTgtCrnt) Tgt(InxTgtCrnt) = TempStg ' Check the new previous enty against its previous entry if there is one. InxTgtCrnt = InxTgtCrnt - 1 If InxTgtCrnt = LBound(Tgt) Then ' Prevous entry is start of array InxTgtCrnt = LBound(Tgt) + 1 End If Else ' These entries in correct sequence InxTgtCrnt = InxTgtCrnt + 1 End If Loop End Sub 

Answer 2

I have a simpler solution using a TreeView object . If you do not mind the order of the nodes being different, and using MSCOMCTL.OCX , use the code below.

Requires registration MSOCOMCTL.OCX.

Consider this data:

Using TreeView (add to UserForm for visualization, code not shown):

Code for outputting tree data (regular module, use TreeToText ):

 Option Explicit Private oTree As TreeView Private Sub CreateTree() On Error Resume Next ' <-- To keep running even error occurred Dim oRng As Range, sParent As String, sChild As String Set oRng = ThisWorkbook.Worksheets("Sheet1").Range("A2") ' <-- Change here to match your Root cell Do Until IsEmpty(oRng) sParent = oRng.Value sChild = oRng.Offset(0, 1).Value If InStr(1, sParent, "root", vbTextCompare) = 1 Then oTree.Nodes.Add Key:=sChild, Text:=sChild Else oTree.Nodes.Add Relative:=oTree.Nodes(sParent).Index, Relationship:=tvwChild, Key:=sChild, Text:=sChild End If '--[ ERROR HANDLING HERE ]-- ' Invalid (Repeating) Child will have the Row number appended If Err.Number = 0 Then Set oRng = oRng.Offset(1, 0) ' Move to Next Row Else oRng.Offset(0,1).Value = sChild & " (" & oRng.Row & ")" Err.Clear End If Loop Set oRng = Nothing End Sub Sub TreeToText() Dim oRng As Range, oNode As Node, sPath As String, oTmp As Variant ' Create Tree from Data Set oTree = New TreeView CreateTree ' Range to dump Tree Data Set oRng = ThisWorkbook.Worksheets("Sheet1").Range("D2") ' <-- Change here For Each oNode In oTree.Nodes sPath = oNode.FullPath If InStr(1, sPath, oTree.PathSeparator, vbTextCompare) > 0 Then oTmp = Split(sPath, oTree.PathSeparator) oRng.Resize(, UBound(oTmp) + 1).Value = oTmp Set oRng = oRng.Offset(1, 0) End If Next Set oRng = Nothing Set oTree = Nothing End Sub 

Code output (hard code on D2):

If you have very large data, you better load the range into memory first.