Create parent child hierarchy from flat file

[lemeister]

I am looking to write some code that will take a flat file and create a child/parent hierarchy from it. The flat file is sorted in order so that each new row is either a new level in the heirarchy or a new child member.

This is a sample of the sorted flat file from which the hierarch should be created:

Book1
	A	B	C	D	E
1	Dimension	In/Out	Type	P#	L#
2	Contract	In	Pol	Prog1	Prog1L1
3	Contract	In	Pol	Prog1	Prog1L2
4	Contract	In	Pol	Prog1	Prog1L3
5	Contract	In	Pol	Prog2	Prog2L1
6	Contract	In	Pol	Prog2	Prog2L2
7	Contract	In	Pol	Prog2	Prog2L3
8	Contract	Out	NonPol	Prog3	Prog3L1
Sheet2

This is the expected format of the hierarchy:

Book1
	A	B	C	D	E	F	G	H
11	Contract						Child	Parent
12	+	In					In	Contract
13		+	Pol				Pol	In
14			+	Prog1			Prog1	Pol
15				+	Prog1L1		Prog1L1	Prog1
16				+	Prog1L2		Prog1L2	Prog1
17				+	Prog1L3		Prog1L3	Prog1
18			+	Prog2			Prog2	Pol
19				+	Prog2L1		Prog2L1	Prog2
20				+	Prog2L2		Prog2L2	Prog2
21				+	Prog2L3		Prog2L3	Prog2
22	+	Out					Out	Contract
23		+	NonPol				NonPol	Out
24			+	Prog3			Prog3	NonPol
25				+	Prog3L1		Prog3L1	Prog3
Sheet2

I am reasonably proficient in VBA but I am struggling with the correct logic to construct this hierarchy, as in should I be starting at the top or bottom of the flat file and how to create the cascading hierarchy. Any help appreciated.

 

[MickG]

Try this for results on sheet2.

Sub MG28Feb19
Dim Rng As Range, Dn As Range, n As Long, Q As Variant, col As Long
Dim K As Variant, Ac As Long, c As Long
Dim R As Range, Temp As String, St As Long, Dic As Object
Set Rng = Range("D2", Range("D" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not Dic.Exists(Dn.Value) Then
        Dic.Add Dn.Value, Array(Dn, Dn.Offset(, -3))
    Else
         Q = Dic(Dn.Value)
         Set Q(0) = Union(Q(0), Dn)
         Dic(Dn.Value) = Q
    End If
Next
With Sheets("Sheet2")
    .Cells(1, 1) = ""
    c = 1
For Each K In Dic.keys
        If Temp = "" Then
            .Cells(1, 1) = Dic(K)(1)
            .Cells(2, 1) = "+"
            .Cells(1, 7) = "Child"
            .Cells(1, 8) = "Parent"
            St = 1: Temp = Dic(K)(1).Offset(, 1)
        ElseIf Not Dic(K)(1).Offset(, 1) = Temp Then
            St = 1: Temp = Dic(K)(1).Offset(, 1)
        Else
            St = 3
        End If
    For Ac = St To 4
       If Ac = 4 Then
            For Each R In Dic(K)(0).Offset(, 1)
                c = c + 1
                .Cells(c, Ac + 1) = R.Value
                .Cells(c, Ac) = "+"
                .Cells(c, 7) = R.Value
                .Cells(c, 8) = Dic(K)(1).Offset(, Ac - 1)
            Next R
        Else
             c = c + 1
             If Ac = 3 Then .Cells(c, Ac) = "+"
             .Cells(c, Ac + 1) = Dic(K)(1).Offset(, Ac)
             .Cells(c + 1, Ac + 1) = "+"
             .Cells(c, 7) = Dic(K)(1).Offset(, Ac)
             .Cells(c, 8) = Dic(K)(1).Offset(, Ac - 1)
        End If
    Next Ac
Next K
    With .Range("A1").Resize(c, 8)
        .Columns.AutoFit
        .Borders.Weight = 2
    End With

End With
End Sub

Regards Mick

 

[lemeister]

Mick,

Thank you so much - that worked like an absolute dream! Really appreciate your help.

 

[MickG]

You're welcome

 

[zezimatje]

Hi Mick,

As a novice I would like to ask how to put this code into power query.
Could you please help? Thanks!