VBA Multiply CHILD item QTY based on PARENT QTY

I Am working with a branch hierarchy represented as ITEM_NO in which "1.2" is a second child of "1" and because there's no further heritage (this "1" is the topmost parent). I have a code that is able to find child-parent relationship and copy a certain value from parent row to child row.


Sub subgroup()

'Disable screen update

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

'Main function

    Dim i As Long
    Dim LastRow As Long
    Dim subgroup As String
    Dim parent As String
    
    With Worksheets("BOM")
        LastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
        
        For i = 2 To LastRow
            If i = 2 Then
                subgroup = .Cells(i, 3).Value
                parent = getParent(.Cells(i, 10))
            ElseIf Left(.Cells(i, 10), Len(parent)) <> parent Then
                subgroup = .Cells(i, 3).Value
                parent = getParent(.Cells(i, 10))
            Else
                .Cells(i, 3).Value = subgroup
            End If
        Next i
    End With
    
'Enable screen update

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

Function getParent(cell As Range) As String
    If Not InStr(1, cell.Value, ".") Then
        getParent = cell.Value
    Else
        getParent = Split(cell, ".")(0) & "." & Split(cell.Value, ".")(1)
    End If
End Function

Now I am trying to figure out how to modify it so that child QTY in column "I" is multiplied to it's parent QTY however many times the child-parent levels appear. So if "child 1.2.1" QTY=1 is multiplied with the "child 1.2" QTY=2, now "child 1.2.1" QTY=1*2=2 and we go a level higher and see that "child 1 QTY=3 so now initial "child 1.2.1" QTY=2*3=6. And I need to do that for every row in the table from bottom to top, possibly, since it's always arranged in a top down order and every ITEM_NO is always unique.

Here's an example image:

I filled each heritage level in different colour. So in this example the QTY of every yellow row must be multiplied with the QTY of the red and then with the grey row. Likewise red row multiplied with the grey row.

Could someone, please, help me?

Solution

Use the following formula in column K to generate the new quantity as shown below:

bottom to top calculation

=IFERROR(INDEX(I:I,MATCH(LEFT(J:J,FIND("#",SUBSTITUTE(J:J,".","#",LEN(J:J)-LEN(SUBSTITUTE(J:J,".",""))))-1),J:J,0))*I:I,I:I)

top to bottom calculation

=IFERROR(IF(INDEX(L:L,MATCH(LEFT(J:J,FIND("#",SUBSTITUTE(J:J,".","#",LEN(J:J)-LEN(SUBSTITUTE(J:J,".",""))))-1),J:J,0))="", INDEX(I:I,MATCH(LEFT(J:J,FIND("#",SUBSTITUTE(J:J,".","#",LEN(J:J)-LEN(SUBSTITUTE(J:J,".",""))))-1),J:J,0)),INDEX(L:L,MATCH(LEFT(J:J,FIND("#",SUBSTITUTE(J:J,".","#",LEN(J:J)-LEN(SUBSTITUTE(J:J,".",""))))-1),J:J,0)))*I:I,I:I)

What does the formula do?

For example for 1.5.3.10

LEFT(J:J,FIND("#",SUBSTITUTE(J:J,".","#",LEN(J:J)-LEN(SUBSTITUTE(J:J,".",""))))-1)
strips off the last group so you get 1.5.3
MATCH( …[1]… ,J:J,0) matches 1.5.3 with column J to get the row number of 1.5.3
INDEX(I:I, …[2]…) gets the value 2 in column I of the row number found by match
*I:I and multiplies it with the value of column I of the current row, so 2*2=4
IFERROR(…) just returns the value of column I of the current row. Because for 1.5 it will strip to 1 and try to find it which it can't. So if there is no parent item to mutipicate with keep the qantitiy the same.

Now this is formula technique. If you really need to do that in VBA you can do it the same way:
Therefore I would read the data of I:J into an array, do all the calculations using WorksheetFunctions there as in the formula, save the result in another array and write the result array back to column I.

Option Explicit

Public Sub TopToBottomCalculation()
    Dim ws As Worksheet 'define worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim LastRow As Long 'find last row with data in column I
    LastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    Dim ArrQty() As Variant 'read quantity into array
    ArrQty = ws.Range("I2", "I" & LastRow).Value
    
    Dim ArrItm() As Variant 'read item no into array
    ArrItm = ws.Range("J2", "J" & LastRow).Value
    
    Dim iRow As Long
    For iRow = LBound(ArrQty, 1) To UBound(ArrQty, 1)
        Dim ParentItem As String 'get parent item number
        
        Dim LastDotPosition As Long
        LastDotPosition = InStrRev(ArrItm(iRow, 1), ".")
        
        If LastDotPosition > 0 Then 'if no dot was found there is no parent
            ParentItem = Left$(ArrItm(iRow, 1), LastDotPosition - 1)
            
            Dim ParentMatch As Double
            ParentMatch = 0 'initialize because in loop
            On Error Resume Next 'next line throws error if no parent item is found
            ParentMatch = Application.WorksheetFunction.Match(ParentItem, ArrItm, 0)
            On Error GoTo 0 're-enable error reporting
            
            If Not ParentMatch = 0 Then 'if there was a parent item multiplicate current quantity with parent quantity
                ArrQty(iRow, 1) = ArrQty(iRow, 1) * ArrQty(ParentMatch, 1)
            End If
        End If
    Next iRow
    
    'write array quantity back to cells
    ws.Range("I2").Resize(RowSize:=UBound(ArrQty, 1)).Value = ArrQty
End Sub

// edit according comments

To be able to jump parents that do not exist like there is a 1 and a 1.2.3 but no 1.2 then the following code will still multiply 1.2.3 with 1 even if there is no 1.2.

Note that there is always an issue with match if you mix numbers and strings. So make sure all your item numbers are entered as strings or match will fail and it will calculate wrong. So if you have 1 as item number make sure it is entered as '1 the apostrophe will not be shown but ensures the 1 is text and not a number, so match can work properly.

Option Explicit

Public Sub TopToBottomCalculation()
    Dim ws As Worksheet 'define worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim LastRow As Long 'find last row with data in column I
    LastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    Dim ArrQty() As Variant 'read quantity into array
    ArrQty = ws.Range("I2", "I" & LastRow).Value
    
    Dim ArrItm() As Variant 'read item no into array
    ArrItm = ws.Range("J2", "J" & LastRow).Value
    
    Dim iRow As Long
    For iRow = LBound(ArrQty, 1) To UBound(ArrQty, 1)
        Dim ParentItem As String     'get parent item number
        
        Dim CurrentItem As String
        CurrentItem = ArrItm(iRow, 1)
        
        Dim LastDotPosition As Long
        LastDotPosition = InStrRev(CurrentItem, ".")
        
        Dim ParentMatch As Double
        ParentMatch = 0 'initialize because in loop
        
        Do While LastDotPosition > 0 And ParentMatch = 0 'loop through parent levels until parent is found or no parent exists
            ParentItem = Left$(CurrentItem, LastDotPosition - 1)
         
            ParentMatch = 0 'initialize because in loop
            On Error Resume Next 'next line throws error if no parent item is found
            ParentMatch = Application.WorksheetFunction.Match(ParentItem, ArrItm, 0)
            On Error GoTo 0 're-enable error reporting
            
            If Not ParentMatch = 0 Then 'if there was a parent item multiplicate current quantity with parent quantity
                ArrQty(iRow, 1) = ArrQty(iRow, 1) * ArrQty(ParentMatch, 1)
            Else 'if parent item did not match then try to find the next upper level parent item
                CurrentItem = ParentItem
                LastDotPosition = InStrRev(CurrentItem, ".")
            End If
            DoEvents
        Loop
    Next iRow
    
    'write array quantity back to cells
    ws.Range("I2").Resize(RowSize:=UBound(ArrQty, 1)).Value = ArrQty
End Sub