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

jbesclapez

Board Regular
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 :

Level1Level2Level3
A1218
A1219
A1220
A1200
A1110
A1111
A1100
A1000

<tbody>
</tbody>

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


ParentChild
A1200A1218
A1200A1219
A1200A1220
A1000A1200
A1100A1110
A1100A1111
A1000A1100
A1000

<tbody>
</tbody>

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

Well-known Member
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
Code:
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
Code:
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
A
B
C
1
Level1Level2Level3
2
A1218
3
A1219
4
A1220
5
A1200
6
A1110
7
A1111
8
A1100
9
A1000
10
Sheet: Sheet1 copy
 
Last edited:

Yongle

Well-known Member
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

Board Regular
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 ;)
 
Last edited:

Some videos you may like

This Week's Hot Topics

Top