Rearrange Hierarchical Data

I've always gotten great help here and, as I'm nearing the end of my project I tend to save the hardest parts for the end (as I always do), so I must ask for your help once more. It's as confusing as anything I've done before, so I'm going to try and explain it the best I can.

Scenario:
I input assembly information into a sheet ("Data"). This info includes part numbers and the hierarchy of how they're assembled (Part2 is a subcomponent of Part1, Part3 is a subcomponent of Part2, etc). On the sheet where I enter part info, I've created a column to enter the hierarchy, where a "1" is the top-most parent part, "2" would be a child of the "1" above it, "3" would be a child of the "2" above it, etc. This can repeat for multiple assemblies, but any number is the child of the lower number above it.

Excel_Hierarchy_Input_Example.png

This all comes around to the way we reformat the parts for another group to enter into our database. We must list the parent (on sheet "MMG_BOM") in the first column, then each child next to that parent in the second column. Which looks like so:

Excel_Hierarchy_Ouput_Example.png

There's such a weird order to it, but there's an order nonetheless. I would be more than happy to clarify anything (I've attached the file as well). I really appreciate any help.

You want to discard #3 ?
Your actual sheet also has a 1/2/3 etc in column 1?

#3 doesn't have to be listed because it has no children (except in the second set where there is a #4).

Yes, the actual sheet has the 1/2/3/4 etc in column 1 to help with defining hierarchy. It'll be filled out by the user.

Thanks

Hi Stusic,
maybe so

Sub ertert()
Dim R(), x, y(), i&, j&
With Sheets("Data")
    x = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
ReDim y(1 To UBound(x), 1 To 3): ReDim R(1 To UBound(x))

For i = 2 To UBound(x)
    R(x(i, 1)) = x(i, 2)
    If x(i, 1) > 1 Then
        j = j + 1
        y(j, 1) = x(i, 1) - 1
        y(j, 2) = R(x(i, 1) - 1)
        y(j, 3) = x(i, 2)
    Else
        GoSub metka
    End If
Next i
metka:
If j > 0 Then
    With Sheets("MMG_BOM").Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(j, 3)
        .Value = y
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
    End With
    j = 0: ReDim y(1 To UBound(x), 1 To 3)
    If i > UBound(x) Then Exit Sub
End If
Return
End Sub

Originally Posted by nilem

Hi Stusic,
maybe so

Sub...

Maybe so? Certainly so! This is fantastic!

I've got to modify it a bit to remove the hierarchy numbers from the first column and move the part numbers so they are in column A & B, then bring in the quantities from column H, but that is no problem. Your code is over my head, but I can add it as a separate sub a the end.

Thank you so much for your help! This is going to save so much time

Hey nilem!

I'm in he process of adding the extra stuff I talked about in my last post, but I've run into a problem when trying to call my other subs from your's. I can't seem to add the call while the RETURN function is there. Is there a way I can call other subs from your's?

Thanks so much for your help