Create a macro to build a hierarchy based on the level

[JorgeBaba]

Hello everyone, need to create an Excel macro that will build a hierarchy based on the levels that are initially exported to a flat file.
My sheet has 3 columns Name, Description and Level, these 3 columns needs to move according to the level column. Example below:
Original Export

Desired result post VBA macro execution

Could anyone kindly share how this could be possible using Excel VBA?

Many Thanks,
Jorge

 

[DanteAmor]

Hi and welcome to MrExcel, and happy new year too

Your data starts in cell A1. The results in cell G1 onwards.
Try this:

Sub hierarchy_level()
  Dim a As Variant, b As Variant
  Dim i As Long, c As Long
  
  a = Range("A1", Range("C" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To WorksheetFunction.Max(Range("C:C")) + 2)
  
  b(1, 1) = a(1, 1)
  b(1, 2) = a(1, 2)
  For i = 2 To UBound(a, 1)
    c = a(i, 3)
    b(i, c) = a(i, 1)
    b(i, c + 1) = a(i, 2)
    b(i, c + 2) = a(i, 3)
    b(1, c + 2) = a(1, 3) & c
  Next
  
  Range("G1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[shinigamilight]

Sub working()
       
        Dim k, i As Integer
        Dim lr, lc As Long
       
        lr = Range("A1").End(xlDown).Row
        lc = Range("A2").End(xlToRight).Column
       
       
        Cells(1, lc).Offset(0, 1) = "Level 2"
        Cells(1, lc).Offset(0, 2) = "Level 3"
       
        For k = 2 To lr
                If Range("C" & k) = 2 Then
                    Range("A" & k, Cells(k, lc)).Cut Range("A" & k).Offset(0, 1)
                ElseIf Range("C" & k) = 3 Then
                    Range("A" & k, Cells(k, lc)).Cut Range("A" & k).Offset(0, 2)
                End If
        Next k
       
   
   
   
End Sub

 

[JorgeBaba]

Hi and welcome to MrExcel, and happy new year too

Your data starts in cell A1. The results in cell G1 onwards.
Try this:

Sub hierarchy_level()
  Dim a As Variant, b As Variant
  Dim i As Long, c As Long
 
  a = Range("A1", Range("C" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To WorksheetFunction.Max(Range("C:C")) + 2)
 
  b(1, 1) = a(1, 1)
  b(1, 2) = a(1, 2)
  For i = 2 To UBound(a, 1)
    c = a(i, 3)
    b(i, c) = a(i, 1)
    b(i, c + 1) = a(i, 2)
    b(i, c + 2) = a(i, 3)
    b(1, c + 2) = a(1, 3) & c
  Next
 
  Range("G1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Hi Dante, happy new year! It works perfectly, and I do appreciate your help.
I have a quick question: if I want the next level to begin after the Parent description, could you please point out which part of the code needs to be changed? Thank you so much for your help so far!

 

[DanteAmor]

if I want the next level to begin after the Parent description, could you please point out which part of the code needs to be changed?

Try this:

Sub hierarchy_level()
  Dim a As Variant, b As Variant
  Dim i As Long, c As Long, n As Long
  
  a = Range("A1", Range("C" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To WorksheetFunction.Max(Range("C:C")) * 3)
  
  b(1, 1) = a(1, 1)
  b(1, 2) = a(1, 2)
  For i = 2 To UBound(a, 1)
    n = a(i, 3)
    c = n + (n - 1)
    b(i, c) = a(i, 1)
    b(i, c + 1) = a(i, 2)
    b(i, c + 2) = a(i, 3)
    b(1, c + 2) = a(1, 3) & n
  Next
  
  Range("G1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[JorgeBaba]

Hi Dante, worked perfectly!! Thank you so much for your help!

 

[JorgeBaba]

Hi Dante, happy new year! It works perfectly, and I do appreciate your help.
I have a quick question: if I want the next level to begin after the Parent description, could you please point out which part of the code needs to be changed? Thank you so much for your help so far!
View attachment 82035

Hi Dante, Is there a way we could suppress the levels (1,2,3,4,....) from the end result ?, essentially, will be the name and description as shown below:

 

[DanteAmor]

Try:

Sub hierarchy_level()
  Dim a As Variant, b As Variant
  Dim i As Long, c As Long, n As Long
  
  a = Range("A1", Range("C" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To WorksheetFunction.Max(Range("C:C")) * 3)
  
  b(1, 1) = a(1, 1)
  b(1, 2) = a(1, 2)
  For i = 2 To UBound(a, 1)
    n = a(i, 3)
    c = n + (n - 1)
    b(i, c) = a(i, 1)
    b(i, c + 1) = a(i, 2)
    'b(i, c + 2) = a(i, 3)
    'b(1, c + 2) = a(1, 3) & n
  Next
  
  Range("G1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[JorgeBaba]

Try:

Sub hierarchy_level()
  Dim a As Variant, b As Variant
  Dim i As Long, c As Long, n As Long
 
  a = Range("A1", Range("C" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To WorksheetFunction.Max(Range("C:C")) * 3)
 
  b(1, 1) = a(1, 1)
  b(1, 2) = a(1, 2)
  For i = 2 To UBound(a, 1)
    n = a(i, 3)
    c = n + (n - 1)
    b(i, c) = a(i, 1)
    b(i, c + 1) = a(i, 2)
    'b(i, c + 2) = a(i, 3)
    'b(1, c + 2) = a(1, 3) & n
  Next
 
  Range("G1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Dante, This is truly amazing, and I do appreciate a lot for your help!! Thats what I needed!! Thank you so so much!!