generation hiearchy to parent child structure

A

Akakaboto

Board Regular
Joined
Jun 27, 2012
Messages
51
I have my meta data in a generation format. However I need to load it to a data base using Parent child hiearchy.

Generation 1 Generation 2 Generation 3 Generation 4
The World Europe Sweden Stockholm
The World Europe Sweden Gothenburg
The World Europe Norway Oslo
The World Asia Thailand Bangkok
The World Asia Japan Tokyo

So I want to convert this data to:
Parent Child
The World
The World Europe
The World Asia
Europe Sweden
Europe Norway
Asia Thailand
Asia Japan
Sweden Stockholm
Sweden Gothenburg
Norway Oslo
Thailand Bangkok
Japan Tokyo

Is there an easy method to do this.
The opposite can be done with ease in PowerPivot using Dax (using Path, Pathlength and, pathitem formulas) as described e.g. here https://www.daxpatterns.com/parent-child-hierarchies/
If there is an easy way to do this in PowerQuery or PowerPivit or if anyone have a macro where I can define number of levles in the generation hiearchy I would highly appreciate if you could share it with me.
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
Try this for results in column "F".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG17Jul15
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 Range("F1") = "Parent Child"
 c = 1
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
[COLOR="Navy"]For[/COLOR] Ac = 0 To 2
   [COLOR="Navy"]Set[/COLOR] nRng = Rng.Offset(, Ac)
     [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] nRng
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
                Dic(Dn.Value).Add (Dn.Offset(, 1).Value), ""
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
   
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
       [COLOR="Navy"]If[/COLOR] c = 1 [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Cells(c, "F") = k
          [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
              c = c + 1
                Cells(c, "F") = k & " " & p
              [COLOR="Navy"]Next[/COLOR] p
    [COLOR="Navy"]Next[/COLOR] k
    Dic.RemoveAll
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
MickG said:
Try this for results in column "F".
Code: 
[COLOR=Navy]Sub[/COLOR] MG17Jul15
[COLOR=Navy]Dim[/COLOR] Dn [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] k [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] p [COLOR=Navy]As[/COLOR] Variant, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]

[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 Range("F1") = "Parent Child"
 c = 1
 [COLOR=Navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
[COLOR=Navy]For[/COLOR] Ac = 0 To 2
   [COLOR=Navy]Set[/COLOR] nRng = Rng.Offset(, Ac)
     [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] nRng
            [COLOR=Navy]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR=Navy]End[/COLOR] If
        
        [COLOR=Navy]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) [COLOR=Navy]Then[/COLOR]
                Dic(Dn.Value).Add (Dn.Offset(, 1).Value), ""
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Dn
   
   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] k [COLOR=Navy]In[/COLOR] Dic.Keys
       [COLOR=Navy]If[/COLOR] c = 1 [COLOR=Navy]Then[/COLOR]
        c = c + 1
        Cells(c, "F") = k
          [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] p [COLOR=Navy]In[/COLOR] Dic(k)
              c = c + 1
                Cells(c, "F") = k & " " & p
              [COLOR=Navy]Next[/COLOR] p
    [COLOR=Navy]Next[/COLOR] k
    Dic.RemoveAll
[COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

Hey Mick!

Thanks for your response.

Script works as per my problem description.

However, I wonder if you can do a few modifications to it.

1. I want Parent and child to be in 2 separate columns and also in a new worksheet instead of a specific cell on existing worksheet. The reason is that number of generations varies between my tables, think the biggest one has 16 generations.

2. I want to be able to specify which columns the macro should apply to. normally I have some a sort column after each generation and quite often a descriptive text
If the macro could be set up something like this.

Gen1 = Range A
Gen2 = Range C
Gen3 = Range E
Gen4 = Range H
Gen5 = Range ""
Gen...
Gen20 = Range ""

Where Range (A;C;E;H) are the columns that should be included and Range "" can be disregarded unless specified.

Not sure If the pic below will be visible to you (I don't know how to properly copy a table from Excel and keep the formatting when pasting to this site).


EZSRMFh


Address to the link if pic is not visible.
https://imgur.com/a/EZSRMFh
 
Last edited:
Upvote 0
Try this:-
See code comments for allocation of columns to loop through !!
Results on Sheet2.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG17Jul01
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] p [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, col [COLOR="Navy"]As[/COLOR] Variant
 
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
Ray = Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 2)
c = 1
col = Array(1, 2, 3, 4) '[COLOR="Green"][B] Place columns you want to loop through here. Like:- Array(1,3,5,7,9,11 etc)[/B][/COLOR]

[COLOR="Navy"]For[/COLOR] Ac = 0 To UBound(col) - 1
   [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
            [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Ray(n, col(Ac))) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(n, col(Ac))) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, col(Ac))).Exists(Ray(n, col(Ac + 1))) [COLOR="Navy"]Then[/COLOR]
                Dic(Ray(n, col(Ac))).Add (Ray(n, col(Ac + 1))), ""
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
   
   nray(1, 1) = "Parent": nray(1, 2) = "Child"
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
       [COLOR="Navy"]If[/COLOR] c = 1 [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        nray(c, 1) = k
          [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
              c = c + 1
                nray(c, 1) = k
                nray(c, 2) = p
            [COLOR="Navy"]Next[/COLOR] p
    [COLOR="Navy"]Next[/COLOR] k
    Dic.RemoveAll
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("a1").Resize(c, 2)
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
    .HorizontalAlignment = xlCenter
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Re: generation hiearchy to parent child structure (SOLVED)

MickG said:
Try this:-
See code comments for allocation of columns to loop through !!
Results on Sheet2.
Code: 
[COLOR=Navy]Sub[/COLOR] MG17Jul01
[COLOR=Navy]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] k [COLOR=Navy]As[/COLOR] Variant, Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] p [COLOR=Navy]As[/COLOR] Variant, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant, col [COLOR=Navy]As[/COLOR] Variant
 
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
Ray = Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 2)
c = 1
col = Array(1, 2, 3, 4) '[COLOR=Green][B] Place columns you want to loop through here. Like:- Array(1,3,5,7,9,11 etc)[/B][/COLOR]

[COLOR=Navy]For[/COLOR] Ac = 0 To UBound(col) - 1
   [COLOR=Navy]For[/COLOR] n = 2 To UBound(Ray, 1)
            [COLOR=Navy]If[/COLOR] Not Dic.Exists(Ray(n, col(Ac))) [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]Set[/COLOR] Dic(Ray(n, col(Ac))) = CreateObject("Scripting.Dictionary")
            [COLOR=Navy]End[/COLOR] If
        
        [COLOR=Navy]If[/COLOR] Not Dic(Ray(n, col(Ac))).Exists(Ray(n, col(Ac + 1))) [COLOR=Navy]Then[/COLOR]
                Dic(Ray(n, col(Ac))).Add (Ray(n, col(Ac + 1))), ""
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] n
   
   nray(1, 1) = "Parent": nray(1, 2) = "Child"
   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] k [COLOR=Navy]In[/COLOR] Dic.Keys
       [COLOR=Navy]If[/COLOR] c = 1 [COLOR=Navy]Then[/COLOR]
        c = c + 1
        nray(c, 1) = k
          [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] p [COLOR=Navy]In[/COLOR] Dic(k)
              c = c + 1
                nray(c, 1) = k
                nray(c, 2) = p
            [COLOR=Navy]Next[/COLOR] p
    [COLOR=Navy]Next[/COLOR] k
    Dic.RemoveAll
[COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("a1").Resize(c, 2)
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
    .HorizontalAlignment = xlCenter
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

Beautiful Mick!!!!!

It works perfectly! Just as I wanted it.
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

Share this page

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