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

jbesclapez

Active Member
Joined
Feb 6, 2010
Messages
275
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
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
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:
Upvote 0
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
 
Upvote 0
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:
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top