Results 1 to 5 of 5

Thread: Create Parent Child relationship in Excel
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Nov 2018
    Posts
    3
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Create Parent Child relationship in Excel

    Hi,
    I'm new to Excel Scripting.
    I need help to create below parent child relationship in excel. I have the source file in below format.
    Level1 Level2 Level3 Level4
    PC_BMROA CD_KENBM 24158 009
    PC_BMROA CD_KENBM 24158 010
    PC_BMROA CD_KENBM 24158 011
    PC_BMROA CD_KENBM 24158 012
    PC_BMROA CD_KENBM 24158 013
    PC_BMROA CD_KENBM 24158 014
    PC_BMROA CD_KENBM 24158 015
    PC_BMROA CD_KENBM 24158 072

    And my output needs to be like this
    Parent Child
    PC_BMROA CD_KENBM
    CD_KENBM 24158
    24158 009
    24158 010
    24158 011
    24158 012
    24158 013
    24158 014
    24158 015
    24158 072



    Any help is appreciated. The number of rows will be dynamic but column can remain the same.

  2. #2
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,837
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Create Parent Child relationship in Excel

    Try this for results in columns "F & G".
    Code:
    Sub MG12Nov56
    Dim Rng As Range, Dn As Range, n As Long, Ray As Variant, ac As Long
    Dim Dic As Object, K As Variant, P As Variant
    Dim c As Long
    
    Ray = Range("A1").CurrentRegion
    Set Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
    
    
    For ac = 1 To UBound(Ray, 2) - 1
        For n = 2 To UBound(Ray, 1)
            If Not Dic.exists(Ray(n, ac)) Then
                    Set Dic(Ray(n, ac)) = CreateObject("Scripting.Dictionary")
              End If
            If Not Dic(Ray(n, ac)).exists(Ray(n, ac + 1)) Then
                    Dic(Ray(n, ac)).Add (Ray(n, ac + 1)), Nothing
            End If
        Next n
    Next ac
       
    c = 1
    Cells(c, "F") = "Parent"
    Cells(c, "G") = "Child"
    
    For Each K In Dic.Keys
        For Each P In Dic(K)
            c = c + 1
            Cells(c, "F") = K
            Cells(c, "G") = P
        Next P
    Next K
    End Sub
    Regards Mick

  3. #3
    New Member
    Join Date
    Nov 2018
    Posts
    3
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Create Parent Child relationship in Excel

    Thannks the code worked.
    Now what if my columns are also varying. How to tackle that?
    If you could please let me know that one.

  4. #4
    New Member
    Join Date
    Nov 2018
    Posts
    3
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Create Parent Child relationship in Excel

    What if I now want to do the reverse. The source is in two column format and the output would be multiple levels.

  5. #5
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,837
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Create Parent Child relationship in Excel

    The original code should cover Multi columns of data.

    Reversing your data is possible as below, but depending on its complexity there could be problems
    Your data for reversing in "A & B" reversed results for previous data in columns "G to J".

    Code:
    Sub MG13Nov11
    'Reverse
    Dim Rng         As Range
    Dim Dn          As Range
    Dim c           As Long
    Dim Dic         As Object
    Dim R           As Range
    Dim ac          As Long
    Dim K           As Variant
    Dim Txt         As Variant
    
    
    Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    Set Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
    
    For Each Dn In Rng
       If Dn.Offset(, -1) <> "" Then
       If Not Dic.exists(Dn.Value) Then
             Dic.Add (Dn.Value), Dn.Offset(, -1)
        Else
            Set Dic(Dn.Value) = Union(Dic(Dn.Value), Dn.Offset(, -1))
        End If
    End If
    Next Dn
    
    
    Dim n
    c = 1
    For n = Dic.Count To 1 Step -1
       ac = 10: c = c + 1
        Txt = Rng(n)
        If Application.CountIf(Rng.Offset(, -1), Txt) = 0 Then
        Cells(c, ac) = Txt
        Cells(1, ac) = "Level " & ac - 5
            Do While Dic.exists(Txt)
                ac = ac - 1
                Txt = Dic(Txt)
               Cells(1, ac) = "Level " & ac - 5
               Cells(c, ac) = Txt
            Loop
        End If
     Next n
    End Sub
    Regards Mick

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •