Create a macro to build a hierarchy based on the level

JorgeBaba

New Member
Joined
Jan 3, 2023
Messages
5
Office Version
  1. 365
Platform
  1. Windows
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
Orginial.JPG


Desired result post VBA macro execution
Desired.JPG


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

Many Thanks,
Jorge
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Hi and welcome to MrExcel, and happy new year too 🥳

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

VBA Code:
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
 
Upvote 0
VBA Code:
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
 

Attachments

  • 1672772457724.png
    1672772457724.png
    36.7 KB · Views: 6
Upvote 0
Hi and welcome to MrExcel, and happy new year too 🥳

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

VBA Code:
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!
AfterParentDescription.JPG
 
Upvote 0
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:

VBA Code:
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
 
Upvote 0
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:
 

Attachments

  • Sol_3.JPG
    Sol_3.JPG
    33.8 KB · Views: 7
Upvote 0
Try:

VBA Code:
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
 
Upvote 0
Solution
Try:

VBA Code:
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!!
 
Upvote 0

Forum statistics

Threads
1,223,952
Messages
6,175,594
Members
452,656
Latest member
earth

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