Adjustment to Parent Child VBA Script

[Carl_H]

First of all I apologize for adding Urgent* to the title but need to solve this ASAP.

I have a script that are looping through a generation format and change it to parent child structure.

The script loops through column 1,3,5,7 and creates a Parent and Child column in a new sheet.

What I would like to add is to add a 3rd column in my output sheet with "Child Description". Information should be taken from column 2,4,6,8.

I don't think it should be that much work to add but my VBA skills are terrible

Sub Gen_to_ParentChild()
Dim Dic As Object, n As Long
Dim k As Variant, Ac As Long
Dim p As Variant, c As Long
Dim Ray As Variant, col As Variant

Set 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, 3, 5, 7) ' Place columns you want to loop through here. Like:- Array(1,3,5,7,9,11 etc)
For Ac = 0 To UBound(col) - 1
For n = 2 To UBound(Ray, 1)
If Not Dic.Exists(Ray(n, col(Ac))) Then
Set Dic(Ray(n, col(Ac))) = CreateObject("Scripting.Dictionary")
End If

If Not Dic(Ray(n, col(Ac))).Exists(Ray(n, col(Ac + 1))) Then
Dic(Ray(n, col(Ac))).Add (Ray(n, col(Ac + 1))), ""
End If
Next n

nray(1, 1) = "Parent": nray(1, 2) = "Child"
For Each k In Dic.Keys
If c = 1 Then
c = c + 1
nray(c, 1) = k
End If
For Each p In Dic(k)
c = c + 1
nray(c, 1) = k
nray(c, 2) = p
Next p
Next k
Dic.RemoveAll
Next Ac
With Sheets("Sheet2").Range("a1").Resize(c, 2)
.Value = nray
.Columns.AutoFit
.Borders.Weight = 2
.HorizontalAlignment = xlCenter
End With
End Sub

 

[mart37]

Sub Gen_to_ParentChild()
Dim Dic As Object, n As Long
Dim k As Variant, Ac As Long
Dim p As Variant, c As Long
Dim Ray As Variant, col As Variant

Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
Ray = Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
c = 1
col = Array(1, 3, 5, 7) ' Place columns you want to loop through here. Like:- Array(1,3,5,7,9,11 etc)
For Ac = 0 To UBound(col) - 1
    For n = 2 To UBound(Ray, 1)
        If Not Dic.Exists(Ray(n, col(Ac))) Then
            Set Dic(Ray(n, col(Ac))) = CreateObject("Scripting.Dictionary")
        End If
       
        If Not Dic(Ray(n, col(Ac))).Exists(Ray(n, col(Ac + 1))) Then
            Dic(Ray(n, col(Ac))).Add (Ray(n, col(Ac + 1))), Ray(n, col(Ac) + 1) & " - " & Ray(n, col(Ac + 1) + 1)
        End If
    Next n
   
    nray(1, 1) = "Parent": nray(1, 2) = "Child": nray(1, 3) = "Child Desc."
    For Each k In Dic.Keys
        If c = 1 Then
            c = c + 1
            nray(c, 1) = k
        End If
        For Each p In Dic(k)
            c = c + 1
            nray(c, 1) = k
            nray(c, 2) = p
            nray(c, 3) = Dic(k)(p)
        Next p
    Next k
    Dic.RemoveAll
Next Ac
With Sheets("sheet2").Range("a1").Resize(c, 3)
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
    .HorizontalAlignment = xlCenter
End With
End Sub

 

[Carl_H]

Sub Gen_to_ParentChild()
Dim Dic As Object, n As Long
Dim k As Variant, Ac As Long
Dim p As Variant, c As Long
Dim Ray As Variant, col As Variant

Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
Ray = Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
c = 1
col = Array(1, 3, 5, 7) ' Place columns you want to loop through here. Like:- Array(1,3,5,7,9,11 etc)
For Ac = 0 To UBound(col) - 1
    For n = 2 To UBound(Ray, 1)
        If Not Dic.Exists(Ray(n, col(Ac))) Then
            Set Dic(Ray(n, col(Ac))) = CreateObject("Scripting.Dictionary")
        End If
      
        If Not Dic(Ray(n, col(Ac))).Exists(Ray(n, col(Ac + 1))) Then
            Dic(Ray(n, col(Ac))).Add (Ray(n, col(Ac + 1))), Ray(n, col(Ac) + 1) & " - " & Ray(n, col(Ac + 1) + 1)
        End If
    Next n
  
    nray(1, 1) = "Parent": nray(1, 2) = "Child": nray(1, 3) = "Child Desc."
    For Each k In Dic.Keys
        If c = 1 Then
            c = c + 1
            nray(c, 1) = k
        End If
        For Each p In Dic(k)
            c = c + 1
            nray(c, 1) = k
            nray(c, 2) = p
            nray(c, 3) = Dic(k)(p)
        Next p
    Next k
    Dic.RemoveAll
Next Ac
With Sheets("sheet2").Range("a1").Resize(c, 3)
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
    .HorizontalAlignment = xlCenter
End With
End Sub

Hello mart37 thanks for taking the time to help me. However it seems the code gives me the description of both the parent and the child and I would like to only have the Child Description. is it possible for you to adjust it?

 

[Carl_H]

Hello mart37 thanks for taking the time to help me. However it seems the code gives me the description of both the parent and the child and I would like to only have the Child Description. is it possible for you to adjust it?

Or rather it gives the the description of all levels for that specific child.

So instead of having it like this (my current output)

I want the output to be like this.

 

[mart37]

change the row: Dic(Ray(n, col(Ac))).Add (Ray(n, col(Ac + 1))), Ray(n, col(Ac + 1) + 1)

 

[Carl_H]

change the row: Dic(Ray(n, col(Ac))).Add (Ray(n, col(Ac + 1))), Ray(n, col(Ac + 1) + 1)

Thank you very much Sir! Works like a charm!