locked
Bill of Materials explosion using recursive VBA code in Excel RRS feed

  • Question

  • Hi,

     

    Please accept my apologies for posting a question that has been asked many times before, but I have spent many hours researching this problem without find a solution.

     

    I need to be able to explode some final assembly demand through a multi levl Bill of Material to find the calculated quantities for the lowest level items based on a quantity at the highest level.

     

    Hopefully the tables below help explain the inputs I have and the outputs required.

     

     

    Input Input Output
    Top Level Demand   Bill of Materials        
    Model Quantity   Parent Child Qty Per   Model   Lowest Level Parts Required Qty
    MOD001 5   MOD001 SA201 1   MOD001     R2345 20
    MOD002 3   MOD001 PA402 1   MOD001     R5544 50
          MOD002 SA200 2   MOD002 …..  
          SA222 SA600 2   MOD002 …..  
          SA222 SA601 3   MOD002 …..  
          SA201 PA401 2   MOD002 …..  
          SA201 PA702 1        
          PA401 R2345 2        
          PA402 R5544 10        

     

    Many thanks in advance for any help.

     

    Thursday, January 27, 2011 9:43 AM

Answers

  • I can't tell which columns your data is in so I'm using constants for each column and made the start row StartDataRow = 3.  Change these constants as required.  You probably want to sort the output column when the macro is finished.  You input data is  incomplete because not all parts have parents so these will be some message boxes indicating that the macro can't find a parent.

     

    Sub GetQuantities()
    
    Const ModelCol = "A"
    Const ModelQntyCol = "B"
    Const ParentCol = "C"
    Const Childcol = "D"
    Const ChildQuantCol = "E"
    Const ModelOutCol = "F"
    Const PartCol = "G"
    Const PartQntCol = "H"
    
    
    Const StartDataRow = 3
    SummaryRowCount = StartDataRow
    
    Lastrow = Range(ParentCol & Rows.Count).End(xlUp).Row
    
    Set ParentRange = Columns(ParentCol)
    Set ChildRange = Columns(Childcol)
    Set TopLevelPart = Columns(ModelCol)
    
    For RowCount = StartDataRow To Lastrow
      Child = Range(Childcol & RowCount)
      'Check if child is lowest level part by search through parent column
      Set c = ParentRange.Find(what:=Child, LookIn:=xlValues, lookat:=xlWhole)
      If c Is Nothing Then
       ChildQuant = Range(ChildQuantCol & RowCount)
       'part is lowest level part
       'now search for all parents
       PartParent = Range(ParentCol & RowCount)
       
       'loop until part is found as another parent
       Do
         Set c = ChildRange.Find(what:=PartParent, LookIn:=xlValues, lookat:=xlWhole)
         If Not c Is Nothing Then
          Quant = Range(ChildQuantCol & c.Row)
          ChildQuant = ChildQuant * Quant
          PartParent = Range(ParentCol & c.Row)
         End If
       Loop While Not c Is Nothing
       
       'Parent should now contain a top level part
       'search for top level part
       Set c = TopLevelPart.Find(what:=PartParent, LookIn:=xlValues, lookat:=xlWhole)
       If c Is Nothing Then
         MsgBox ("Cannot find top Level Part : " & PartParent)
       Else
         Quant = Range(ModelQntyCol & c.Row)
         ChildQuant = ChildQuant * Quant
         Range(ModelOutCol & SummaryRowCount) = PartParent
         Range(PartCol & SummaryRowCount) = Child
         Range(PartQntCol & SummaryRowCount) = ChildQuant
         SummaryRowCount = SummaryRowCount + 1
       End If
      End If
    
    Next RowCount
    
    
    End Sub
    
    

    jdweng
    Thursday, January 27, 2011 1:21 PM

All replies

  • I can't tell which columns your data is in so I'm using constants for each column and made the start row StartDataRow = 3.  Change these constants as required.  You probably want to sort the output column when the macro is finished.  You input data is  incomplete because not all parts have parents so these will be some message boxes indicating that the macro can't find a parent.

     

    Sub GetQuantities()
    
    Const ModelCol = "A"
    Const ModelQntyCol = "B"
    Const ParentCol = "C"
    Const Childcol = "D"
    Const ChildQuantCol = "E"
    Const ModelOutCol = "F"
    Const PartCol = "G"
    Const PartQntCol = "H"
    
    
    Const StartDataRow = 3
    SummaryRowCount = StartDataRow
    
    Lastrow = Range(ParentCol & Rows.Count).End(xlUp).Row
    
    Set ParentRange = Columns(ParentCol)
    Set ChildRange = Columns(Childcol)
    Set TopLevelPart = Columns(ModelCol)
    
    For RowCount = StartDataRow To Lastrow
      Child = Range(Childcol & RowCount)
      'Check if child is lowest level part by search through parent column
      Set c = ParentRange.Find(what:=Child, LookIn:=xlValues, lookat:=xlWhole)
      If c Is Nothing Then
       ChildQuant = Range(ChildQuantCol & RowCount)
       'part is lowest level part
       'now search for all parents
       PartParent = Range(ParentCol & RowCount)
       
       'loop until part is found as another parent
       Do
         Set c = ChildRange.Find(what:=PartParent, LookIn:=xlValues, lookat:=xlWhole)
         If Not c Is Nothing Then
          Quant = Range(ChildQuantCol & c.Row)
          ChildQuant = ChildQuant * Quant
          PartParent = Range(ParentCol & c.Row)
         End If
       Loop While Not c Is Nothing
       
       'Parent should now contain a top level part
       'search for top level part
       Set c = TopLevelPart.Find(what:=PartParent, LookIn:=xlValues, lookat:=xlWhole)
       If c Is Nothing Then
         MsgBox ("Cannot find top Level Part : " & PartParent)
       Else
         Quant = Range(ModelQntyCol & c.Row)
         ChildQuant = ChildQuant * Quant
         Range(ModelOutCol & SummaryRowCount) = PartParent
         Range(PartCol & SummaryRowCount) = Child
         Range(PartQntCol & SummaryRowCount) = ChildQuant
         SummaryRowCount = SummaryRowCount + 1
       End If
      End If
    
    Next RowCount
    
    
    End Sub
    
    

    jdweng
    Thursday, January 27, 2011 1:21 PM
  • With a slightly different structure you could do quite well only using formulas.
    Top-level table as now, name it TopLevel for convenience of explanation
    Bill of Material table, as now plus a column to the right for QtyRequired; name it as BoMTable.
    Lowest level parts = a table with all the lowest level parts listed and a column for the TotalQty required.

    What this won't give you is the top level part alongside the lower level part in the output table.
    If that is important we need to do it differently.

    BoMTable.QtyRequired formula would be
    =(SUMIF(TopLevelModel,Parent,TopLevelQuantity)+SUMIF(BoMTableChild,Parent,BoMTableQtyPer))*QtyPer
    where TopLevelModel (for example is the whole Model column in the TopLevel table), but Parent and QtyPer are the cells in BoMTable on the same row as the formula.

    LowestLevel.TotalQty would just be
    =SUMIF(BoMTableChild,LowLevelPart,BoMTableQtyRequired)


    Bill Manville. Excel MVP, Oxford, England. www.manville.org.uk
    Thursday, January 27, 2011 1:31 PM
  • Joel,

    Many thanks for a working solution, I used your code from above and got the required output. I just need to spend some time to understand it and apply it to the thousands of parts I need to explode.

    I spent many hours trying to find a solution to this, so to get one this quickly was brilliant.

    Thanks again.

    Thursday, January 27, 2011 1:44 PM
  • Bill,

    Thanks for taking the time to offer an alternative methodology. I have many thousands of top level items, many thousands of Bills of Material and I do need to see the Top level alongside the lowest level. Given this I think I am best to stick with VBA ?

    But, as you took the time to offer an alternative so quickly, I will invest as much of my time as necessary to understand and learn from your solution.

    Having a number of alterntive options in my armoury has got to be the way to go.

    Many thanks

    Thursday, January 27, 2011 1:50 PM
  • Here is an alternative approach. It is coded as a multi-cell array UDF formula but you could easily change it to a Sub if you wanted.

    Select a range of cells 3 wide and N deep where N is more than enough rows to hold all the output, key in the function call =ExplodeBOM(TopLeveldemand,BOM) and enter using Control/Shift/Enter. TopLeveldemand should be the range that has the top-level you want output for and the quantity, and BOm should be the range of the BOM data.

    Note: the BOM data MUST be sorted ascending on parent.

    It will run faster than Joel's solution and will also allow you to have intermediate assemblies in the list of top-level demands.

    The advantage of using an array formula is that it dynamically recalculates when the data changes. The disadvantage is that you have to enter it into more than enough rows to fit all the output (without knowing exactly how many that is)

    Public Function ExplodeBOM(TopDemand As Range, BOM As Range) As Variant
      Dim vOut() As Variant
      Dim vIn As Variant
      Dim vBOM As Variant
      Dim nTops As Long
      Dim jOut As Long
      Dim j As Long
      Dim k As Long
      Dim RequdQty As Long
      Dim strParent As String
      Dim strTop As String
      '
      ' initialise output array
      '
      ReDim vOut(1 To Application.Caller.Rows.Count, 1 To 3)
      For j = 1 To UBound(vOut)
        For k = 1 To UBound(vOut, 2)
          vOut(j, k) = ""
        Next k
      Next j
    
      On Error GoTo FuncErr
    
      vIn = TopDemand.Value2
      If Not IsArray(vIn) Then GoTo FuncErr
      '
      ' process each top-level input
      '
      For j = 1 To UBound(vIn)
        If vIn(j, 2) > 0 Then
          RequdQty = vIn(j, 2)
          strTop = Trim(CStr(vIn(j, 1)))
          strParent = strTop
          If Len(strTop) = 0 Or jOut > UBound(vOut) Then Exit For
          GetParentChild strTop, strParent, BOM, RequdQty, vOut(), jOut
        End If
      Next j
      '
      ' return output
      '
      ExplodeBOM = vOut
    
      Exit Function
    FuncErr:
      ExplodeBOM = CVErr(xlErrNA)
    End Function
    Sub GetParentChild(strTop As String, strParent As String, BOM As Range, Qty As Long, vOut() As Variant, jOut As Long)
      Dim vRow As Variant
      Dim rngParent As Range
      Dim vData As Variant
      Dim nParents As Long
      Dim j As Long
      Dim blFound As Boolean
      Dim ChildQty As Long
    
      blFound = False
      '
      ' Assume BOM is sorted ascending on Parent
      '
      Set rngParent = BOM.Resize(, 1)
      vRow = Application.Match(strParent, rngParent, True)
    
      If IsError(vRow) Then
        '
        ' parent does not exist
        '
      Else
        If strParent <> Trim(CStr(rngParent.Cells(CLng(vRow), 1).Value2)) Then
          '
          ' no exact match found
          '
        Else
          blFound = True
          '
          ' get all BOM data for this parent
          '
          nParents = Application.CountIf(rngParent, "=" & strParent)
          vData = BOM.Offset(CLng(vRow) - nParents, 0).Resize(nParents, 3).Value2
          For j = 1 To nParents
            '
            ' recurse each child for this parent
            '
            strParent = Trim(CStr(vData(j, 2)))
            ChildQty = Qty * CLng(vData(j, 3))
            GetParentChild strTop, strParent, BOM, ChildQty, vOut(), jOut
          Next j
        End If
      End If
    
      If Not blFound Then
        '
        ' store Results
        '
        jOut = jOut + 1
        If jOut <= UBound(vOut) Then
          vOut(jOut, 1) = strTop
          vOut(jOut, 2) = strParent
          vOut(jOut, 3) = Qty
        End If
      End If
    End Sub


    Charles Excel MVP The Excel Calculation Site http://www.decisionmodels.com/
    Thursday, January 27, 2011 5:23 PM
  • Hey, I am currently trying to do a BOM Explosion as well. I also used the sumif formula to get the RMs needed.

    The problem is, my BOM consists of 100,000 rows. I managed to trim it down to 60,000, but still my laptop won't

    compute.

    Anybody know a "computer friendly" solution?

    Friday, April 29, 2011 6:22 PM
  • Go to access and import the file.  Access is better at managing your lap top resourses than excel.
    jdweng
    Friday, April 29, 2011 6:45 PM
  • Sort your BOM data and use the code below: should be fast enough for most purposes.

    Here is my code, converted so that you can use it either as a sub or a function, and with additional output options so that you can get unique lists of final components (OutType=2) or top and final pairs(OutType=3) or the full list (outType=1) etc.

    You could also feed the output into a pivot table if you wanted more flexibility.

    Note that you need a reference (VBE-->Tools-->References) to Microsoft scripting runtime, and the BOM data must be sorted ascending on Parent, Child

    Code edited to fix lack of Option Base 1

     

    Sub p_Start()

    Dim rSearch As Range
    Dim rAssemblies As Range
    Dim lLastrow As Long
    Dim OutPutArray As Variant

    '
    ' NOTE: the Bill of Materials must be sorted ascending on parent and Child
    '
    ' Bill of materials is in columnds D:E, work out the search range
    lLastrow = Range("D" & Rows.Count).End(xlUp).Row
    Set rSearch = Range("D3").Resize(lLastrow - 2, 3)

    ' Cycle through all top level assemblies & use recursive rotuine to get to lowest levels
    lLastrow = Range("A" & Rows.Count).End(xlUp).Row
    Set rAssemblies = Range("A3").Resize(lLastrow - 2, 2)

    OutPutArray = ExplodeBOM3(rAssemblies, rSearch, 3)

    p_OutPutToSheet OutPutArray

    End Sub
    Sub p_OutPutToSheet(OutPutArray As Variant)

    ' Output the top level parent and the lowest level part(s)

    Range("H3").Resize(UBound(OutPutArray, 1), UBound(OutPutArray, 2)) = OutPutArray

    End Sub
    Public Function ExplodeBOM3(TopDemand As Range, BOM As Range, OutType As Long) As Variant
    Dim vOut() As Variant

    Dim vIn As Variant
    Dim jOut As Long
    Dim j As Long
    Dim RequdQty As Long
    Dim strParent As String
    Dim strTop As String


    'On Error GoTo FuncErr
    '
    ' initialise output array
    '
    ReDim vOut(1 To 3, 1 To 100)

    vIn = TopDemand.Value2
    If Not IsArray(vIn) Then GoTo FuncErr
    '
    ' process each top-level input
    '
    For j = 1 To UBound(vIn)
    If vIn(j, 2) > 0 Then
    RequdQty = vIn(j, 2)
    strTop = Trim(CStr(vIn(j, 1)))
    strParent = strTop
    If Len(strTop) = 0 Then Exit For
    GetParentChild strTop, strParent, BOM, RequdQty, vOut(), jOut
    End If
    Next j

    ReDim Preserve vOut(1 To 3, 1 To jOut)
    ExplodeBOM3 = CreateOutput(vOut, OutType)
    Exit Function
    FuncErr:
    ExplodeBOM3 = CVErr(xlErrNA)
    End Function
    Function CreateOutput(vOut() As Variant, OutType As Long) As Variant
    Dim j As Long
    Dim k As Long
    Dim vOut2() As Variant
    Dim strPair As String
    Dim vItem As Variant

    Dim OutDict As New Scripting.Dictionary

    Select Case OutType
    Case 2
    '
    ' unique end components
    '
    For j = 1 To UBound(vOut, 2)
    If Len(Trim(vOut(2, j))) = 0 Then Exit For
    If OutDict.Exists(vOut(2, j)) Then
    OutDict.Item(vOut(2, j)) = OutDict.Item(vOut(2, j)) + vOut(3, j)
    Else
    OutDict.Add vOut(2, j), vOut(3, j)
    End If
    Next j
    j = 0
    ReDim vOut2(1 To OutDict.Count, 1 To 3)
    For Each vItem In OutDict
    j = j + 1
    vOut2(j, 1) = vItem
    vOut2(j, 2) = OutDict(vItem)
    Next vItem
    CreateOutput = vOut2
    Case 3
    '
    ' unique pairs
    '
    k = 0
    For j = 1 To UBound(vOut, 2)
    If Len(Trim(vOut(1, j))) = 0 Then Exit For
    strPair = vOut(1, j) & "|" & vOut(2, j)
    If OutDict.Exists(strPair) Then
    OutDict.Item(strPair) = OutDict.Item(strPair) + vOut(3, j)
    Else
    OutDict.Add strPair, vOut(3, j)
    End If
    Next j
    j = 0
    ReDim vOut2(1 To OutDict.Count, 1 To 3)
    For Each vItem In OutDict
    j = j + 1
    strPair = vItem
    k = InStr(strPair, "|")
    vOut2(j, 1) = Left(strPair, k - 1)
    vOut2(j, 2) = Right(strPair, Len(strPair) - k)
    vOut2(j, 3) = OutDict(vItem)
    Next vItem
    CreateOutput = vOut2
    Case Else
    '
    ' full list
    '
    CreateOutput = Application.Transpose(vOut)
    End Select
    End Function
    Sub GetParentChild(strTop As String, strParent As String, BOM As Range, Qty As Long, vOut() As Variant, jOut As Long)
    Dim vRow As Variant
    Dim rngParent As Range
    Dim vData As Variant
    Dim nParents As Long
    Dim j As Long
    Dim blFound As Boolean
    Dim ChildQty As Long

    blFound = False
    '
    ' Assume BOM is sorted ascending on Parent
    '
    Set rngParent = BOM.Resize(, 1)
    vRow = Application.Match(strParent, rngParent, True)

    If IsError(vRow) Then
    '
    ' parent does not exist
    '
    Else
    If strParent <> Trim(CStr(rngParent.Cells(CLng(vRow), 1).Value2)) Then
    '
    ' no exact match found
    '
    Else
    blFound = True
    '
    ' get all BOM data for this parent
    '
    nParents = Application.CountIf(rngParent, "=" & strParent)
    vData = BOM.Offset(CLng(vRow) - nParents, 0).Resize(nParents, 3).Value2
    For j = 1 To nParents
    '
    ' recurse each child for this parent
    '
    strParent = Trim(CStr(vData(j, 2)))
    ChildQty = Qty * CLng(vData(j, 3))
    GetParentChild strTop, strParent, BOM, ChildQty, vOut(), jOut
    Next j
    End If
    End If

    If Not blFound Then
    '
    ' store Results
    '
    jOut = jOut + 1
    If jOut > UBound(vOut, 2) Then
    ReDim Preserve vOut(1 To 3, 1 To UBound(vOut, 2) * 2)
    End If
    vOut(1, jOut) = strTop
    vOut(2, jOut) = strParent
    vOut(3, jOut) = Qty
    End If
    End Sub

    Charles Excel MVP The Excel Calculation Site http://www.decisionmodels.com/
    Saturday, April 30, 2011 9:56 AM
  • Excel 2010 (only) Tables, PivotTables
    Three assembly levels.
    No code needed.
    http://c3017412.r12.cf0.rackcdn.com/04_30_11.xlsx
    If you get *.zip, don't unzip, just rename *.xlsx

    Saturday, April 30, 2011 11:49 PM
  • this code proposed by Joel works great on one sheet. Could somemody give any suggestion/samples how to remove constant and write it if top level demand, bill of materials and output should be in different sheets.

    Howvever I try, I receive complile error message: "constant expressions required".

    F.i

    Const ModelCol = Sheets("Sheet2").Columns("A")
    Const ModelQntyCol = Sheets("Sheet2").Columns("b")
    Const ParentCol = Sheets("Sheet3").Columns("a")
    Const Childcol = Sheets("Sheet3").Columns("b")
    Const ChildQuantCol = Sheets("Sheet3").Columns("c")
    Const ModelOutCol = Sheets("Sheet4").Columns("a")
    Const PartCol = Sheets("Sheet4").Columns("b")
    Const PartQntCol = Sheets("Sheet4").Columns("c")

    your kind help will be really highly appreciated.

    Tuesday, May 10, 2011 4:54 PM
  •  

    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

    Set ModelCol = Sheets("Sheet2").Columns("A")
    Set ModelQntyCol = Sheets("Sheet2").Columns("b")
    Set ParentCol = Sheets("Sheet3").Columns("a")
    Set Childcol = Sheets("Sheet3").Columns("b")
    Set ChildQuantCol = Sheets("Sheet3").Columns("c")
    Set ModelOutCol = Sheets("Sheet4").Columns("a")
    Set PartCol = Sheets("Sheet4").Columns("b")
    Set PartQntCol = Sheets("Sheet4").Columns("c")


    jdweng
    Tuesday, May 10, 2011 6:22 PM
  • ther is some problems with code I last posted.  Below I re-wrote my original code.  I tried to write the oringal posting to make it easy to change the columns.  The approach using a constant doesn't work with multiuple sheets so yo have to use Dim statements to define the ranges.

    like this

    Set ModelCol = Sheets("Sheet2").Columns("A")

    Then to access any cell in the range you have to use this format

    ModelCol.Cells(MyRow,1)

     

     

    Sub test()
    
    
    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
    
    Set ModelCol = Sheets("Sheet2").Columns("A")
    Set ModelQntyCol = Sheets("Sheet2").Columns("b")
    Set ParentCol = Sheets("Sheet3").Columns("a")
    Set Childcol = Sheets("Sheet3").Columns("b")
    Set ChildQuantCol = Sheets("Sheet3").Columns("c")
    Set ModelOutCol = Sheets("Sheet4").Columns("a")
    Set PartCol = Sheets("Sheet4").Columns("b")
    Set PartQntCol = Sheets("Sheet4").Columns("c")
    
    
    
    
    End Sub
    Sub GetQuantities()
    
    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
    
    Set ModelCol = Sheets("Sheet2").Columns("A")
    Set ModelQntyCol = Sheets("Sheet2").Columns("b")
    Set ParentCol = Sheets("Sheet3").Columns("a")
    Set Childcol = Sheets("Sheet3").Columns("b")
    Set ChildQuantCol = Sheets("Sheet3").Columns("c")
    Set ModelOutCol = Sheets("Sheet4").Columns("a")
    Set PartCol = Sheets("Sheet4").Columns("b")
    Set PartQntCol = Sheets("Sheet4").Columns("c")
    
    
    Const StartDataRow = 3
    SummaryRowCount = StartDataRow
    
    Lastrow = ParentCol.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    Set ParentRange = Columns(ParentCol)
    Set ChildRange = Columns(Childcol)
    Set TopLevelPart = Columns(ModelCol)
    
    For RowCount = StartDataRow To Lastrow
     Child = Childcol.Cells(RowCount, 1)
     'Check if child is lowest level part by search through parent column
     Set c = ParentRange.Find(what:=Child, LookIn:=xlValues, lookat:=xlWhole)
     If c Is Nothing Then
      ChildQuant = ChildQuantCol.Cells(RowCount, 1)
      'part is lowest level part
      'now search for all parents
      PartParent = ParentCol.Cells(RowCount, 1)
      
      'loop until part is found as another parent
      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
      
      'Parent should now contain a top level part
      'search for top level part
      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
    
    
    

    jdweng
    Tuesday, May 10, 2011 6:57 PM
  • Joel,

    first of all  - thank You so much for your feedback.

    Unfortunaltely, not I received and run-time error 13: Type mismatch for this part:

    Set ParentRange = Columns(ParentCol)
    Set ChildRange = Columns(Childcol)
    Set TopLevelPart = Columns(ModelCol)

    I tried to refer also sheets have to be, but ..

     

    And 2nd issue - how to write that after the demand for first column (f.i in that case Sheet 2, row b) I would like to calculate demand for row C separately (f.i first week demand is in column b; next week demand in column c etc)?

    Are You able to help me one time more?

     

    really great thanks!

     

     


    Wednesday, May 11, 2011 3:17 PM
  • i Misssed this error

     

    From

    Set ParentRange = Columns(ParentCol)
    Set ChildRange = Columns(Childcol)
    Set TopLevelPart = Columns(ModelCol)

    To

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

     

    You really don't need two sets of variables but I tried to keep the new code and the old code as similar as poosible since it was already working.  A they say,if it ain' broken don't try to fix it!.

     

    I added to the code below the additional request for the code to work over multiple weeks

     

    Sub GetQuantities()
    
    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
    
    Set ModelCol = Sheets("Sheet2").Columns("A")
    Set ModelQntyCol = Sheets("Sheet2").Columns("b")
    Set ParentCol = Sheets("Sheet3").Columns("a")
    Set Childcol = Sheets("Sheet3").Columns("b")
    Set ChildQuantCol = Sheets("Sheet3").Columns("c")
    Set ModelOutCol = Sheets("Sheet4").Columns("a")
    Set PartCol = Sheets("Sheet4").Columns("b")
    Set PartQntCol = Sheets("Sheet4").Columns("c")
    
    
    Const StartDataRow = 3
    SummaryRowCount = StartDataRow
    
    Lastrow = ParentCol.Cells(Rows.Count, 1).End(xlUp).Row
    
    Set ParentRange = ParentCol
    Set ChildRange = Childcol
    Set TopLevelPart = ModelCol
    
    WeekNumber = 1
    Do while ChildQuantCol.cells(1,WeekNumber) <> ""
      For RowCount = StartDataRow To Lastrow
       Child = Childcol.Cells(RowCount, 1)
       'Check if child is lowest level part by search through parent column
       Set c = ParentRange.Find(what:=Child, LookIn:=xlValues, lookat:=xlWhole)
       If c Is Nothing Then
         ChildQuant = ChildQuantCol.Cells(RowCount, WeekNumber)
         'part is lowest level part
         'now search for all parents
         PartParent = ParentCol.Cells(RowCount, 1)
     
         'loop until part is found as another parent
         Do
          Set c = ChildRange.Find(what:=PartParent, _
            LookIn:=xlValues, lookat:=xlWhole)
          If Not c Is Nothing Then
            Quant = ChildQuantCol.Cells(c.Row, WeekNumber)
            ChildQuant = ChildQuant * Quant
            PartParent = ParentCol.Cells(c.Row, 1)
          End If
         Loop While Not c Is Nothing
     
         'Parent should now contain a top level part
         'search for top level part
         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, WeekNumber) = ChildQuant
          SummaryRowCount = SummaryRowCount + 1
         End If
       End If
    
      Next RowCount
      WeekNumber = WeekNumber + 1
    Loop
    
    End Sub

     


    jdweng
    Wednesday, May 11, 2011 8:42 PM
  • The formula only approach proposed by Bill worked well for me, but I had to modify the first formula to:

    =(SUMIF(TopLevel[Model],[@Parent],TopLevel[Quantity])+SUMIF([Child],[@Parent],[QtyRequired]))*[@QtyPer]

    Tables were set up first using "Format as Table" in Excel 2010 and named as suggested by Bill.

    Saturday, April 20, 2013 6:04 PM
  • This is an old thread but it's extremely useful.  I'm using Joel's solution, but I have a case in which that vba doesn't seem to work.  The issue is that one of my top level parts is also a child for another top level part.  In other words, using the data for the original question, I have demand for MOD001, but I also have demand for MOD003 in which MOD001 is one of the components.  This seems to completely break the logic -- it's runs without error but the results are no longer correct when I include MOD003 in the Bill of Materials.

    Any help is greatly appreciated! 

    Saturday, April 19, 2014 7:25 PM
  • I 'll take a look at it tomorrow.  Can you modify the original input data to minimize to demonstrate the issue?  this will simplify my efforts.  Or provide you latest code along with a simple set of input data.

    jdweng

    Saturday, April 19, 2014 9:34 PM
  • Hi Joel,

    Thanks for your solution. It works great. I have been working on a small tweak to it and couldn't figure out the answer. Could you please help me with it?

    This is a case when a child has multiple parent. For eg the sample data could be:

    Finished Goods Production in Tons Parent Child Actual Usage UOM
    ABC 10 ABC A 1
    DEA 20 ABC B 2
        ABC C 3
        DEA D 4
        DEA E 5
        DEA A 6
        A p 7

    Thanks a lot for the help.

    Tuesday, February 28, 2017 7:30 AM