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
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
VBA Code:
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
Last edited by a moderator: