Hey kokosek,

Ive been able to achieve multi-level explosion of FG, but no idea how to output also mid-lvl components. Anywhere i edit the code it triggers errors. Also if i try to make the calculation for output in the code it outputs mismatch error, so i left it as quantities for now. The code outputs lowest lvl components and its quanitites. Also how can i make Period inputs recursive? So i do not need to copy paste this code just to refer different cell of input.. Any ideas, help?




Sub BomExplosion()

Dim ModelCol As Range
Dim ModelQntyCol As Range
Dim ParentCol As Range
Dim Childcol As Range
Dim ChildQuantCol As Range
Dim ModelOutCol As Range
Dim PartCol As Range
Dim PartQntCol As Range
Dim BaseQty As Range

Set ModelCol = Sheets("PLAN").Columns("A")
Set ModelQntyCol = Sheets("PLAN").Columns("D")
Set ParentCol = Sheets("BOM").Columns("A")
Set Childcol = Sheets("BOM").Columns("C")
Set ChildQuantCol = Sheets("BOM").Columns("E")
Set ModelOutCol = Sheets("Output").Columns("A")
Set PartCol = Sheets("Output").Columns("D")
Set PartQntCol = Sheets("Output").Columns("F")


Const StartDataRow = 2
SummaryRowCount = StartDataRow

Lastrow = ParentCol.Cells(Rows.Count, 1).End(xlUp).Row


Set ParentRange = ParentCol
Set ChildRange = Childcol
Set TopLevelPart = ModelCol

For RowCount = StartDataRow To Lastrow
 Child = Childcol.Cells(RowCount, 1)
 
 Set c = ParentRange.Find(what:=Child, LookIn:=xlValues, lookat:=xlWhole)
 If c Is Nothing Then
  ChildQuant = ChildQuantCol.Cells(RowCount, 1)
  
  PartParent = ParentCol.Cells(RowCount, 1)
  
  
  Do
   Set c = ChildRange.Find(what:=PartParent, LookIn:=xlValues, lookat:=xlWhole)
   If Not c Is Nothing Then
   Quant = ChildQuantCol.Cells(c.Row, 1)
   ChildQuant = ChildQuant * Quant
   PartParent = ParentCol.Cells(c.Row, 1)
   End If
  Loop While Not c Is Nothing
  
  
  Set c = TopLevelPart.Find(what:=PartParent, LookIn:=xlValues, lookat:=xlWhole)
  If c Is Nothing Then
   MsgBox ("Cannot find top Level Part : " & PartParent)
  Else
   Quant = ModelQntyCol.Cells(c.Row, 1)
   ChildQuant = ChildQuant * Quant
   ModelOutCol.Cells(SummaryRowCount, 1) = PartParent
   PartCol.Cells(SummaryRowCount, 1) = Child
   PartQntCol.Cells(SummaryRowCount, 1) = ChildQuant
   SummaryRowCount = SummaryRowCount + 1
  End If
 End If

Next RowCount


End Sub
thanks in advance!