VBA to select an array and bring back parent of a childs in another cell/column

[jbesclapez]

Hi Mr Excel

I have a table that can change in rows/columns. In this table I only have one data per row. The columns indicate the hierarchy of parent child structure. The parent is on the left.

For example :

[TABLE="width: 500"]
<tbody>[TR]
[TD]Level1[/TD]
[TD]Level2[/TD]
[TD]Level3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]A1218[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]A1219[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]A1220[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A1200[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]A1110[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]A1111[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A1100[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A1000[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

So from the previous table we have this hierarchy. Please note that the A1000 is the root so it has no parent


[TABLE="width: 500"]
<tbody>[TR]
[TD]Parent[/TD]
[TD]Child[/TD]
[/TR]
[TR]
[TD]A1200[/TD]
[TD]A1218[/TD]
[/TR]
[TR]
[TD]A1200[/TD]
[TD]A1219[/TD]
[/TR]
[TR]
[TD]A1200[/TD]
[TD]A1220[/TD]
[/TR]
[TR]
[TD]A1000[/TD]
[TD]A1200[/TD]
[/TR]
[TR]
[TD]A1100[/TD]
[TD]A1110[/TD]
[/TR]
[TR]
[TD]A1100[/TD]
[TD]A1111[/TD]
[/TR]
[TR]
[TD]A1000[/TD]
[TD]A1100[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A1000[/TD]
[/TR]
</tbody>[/TABLE]

I would like to have a VBA where you select the table above - whatever the depth level - and it creates the parent child table elsewhere.
I can read VBA but this level is too high for me. I will rearrange it all for my needs if you can help me create the difficult part.

Thanks

 

[Yongle]

Perhaps it is more complicated that you have written
Here is a method that you can adapt

To test, enter everything EXACTLY as per instructions in a NEW workbook

1. Copy values from sheet below into the same range (A1:C9) in Sheet1

2. Place in STANDARD module

Sub CreateHierarchy()
    Dim rng  As Range, r As Long, c As Long
    With ActiveSheet
        Set rng = .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
        rng = rng(rng.Rows.Count, 1)
        For c = 2 To 3
            For r = rng.Rows.Count - 1 To 2 Step -1
                If .Cells(r, c) = "" Then .Cells(r, c) = .Cells(r + 1, c)
            Next
        Next c
    End With
End Sub

Sub FilterMe()
    With ActiveSheet
        Dim c   As Long:        c = ActiveCell.Column
        Dim r   As Range:       Set r = .Range("A:C")
        On Error Resume Next
        If c < 4 Then r.AutoFilter Field:=c, Criteria1:=ActiveCell
    End With
End Sub

3. Place in SHEET module

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    Call FilterMe
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Target.Column > 3 Then Me.ShowAllData
End Sub

4. Test by running CreateHierarchy

5. Double click in the data to filter on cell value

6. Click on any cell in columns to right of data to clear the filter

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]

A​

[/th][th]

B​

[/th][th]

C​

[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

1​

[/td][td]Level1[/td][td]Level2[/td][td]Level3[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

2​

[/td][td][/td][td][/td][td]A1218[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

3​

[/td][td][/td][td][/td][td]A1219[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

4​

[/td][td][/td][td][/td][td]A1220[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

5​

[/td][td][/td][td]A1200[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

6​

[/td][td][/td][td][/td][td]A1110[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

7​

[/td][td][/td][td][/td][td]A1111[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

8​

[/td][td][/td][td]A1100[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

9​

[/td][td]A1000[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

10​

[/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet1 copy[/td][/tr][/table]

 

[Yongle]

I should have explained that above is a starting point
- does it scale up when you test on your complete data set?
- does filtering on a single item provide what you need?
- what do you expect as the final output when you select an item

 

[jbesclapez]

Dear All,


I managed to do taht using only formula

In column AD6 I have the unique IDs of the children with a title in AD6 and the data below
In colum AE6 I have the level of the child using this formula in AE7 to last row

=INDEX($R$8:$AC$8;SUMPRODUCT(MAX(($R$9:$AC$636=AD590)*(COLUMN($R$9:$AC$636))))-COLUMN($R$8)+1)

In colum AF I have a title and in AF7 I have this array formula to the last row.

{=INDEX($AD$8:$AD$636;MIN(IF($AE590:$AE$636=AE590-1;ROW($AE590:$AE$636)-7;"")))}

As it is an array formula dont forget the CTRL+ENTER.

I know it is not VBA but I had to much trouble to put it in VBA. And this does the job

I hope that helps anyone.

Beautiful