Home » excel » vba – Need help summing unit weights and a multi-level parts list

# vba – Need help summing unit weights and a multi-level parts list

Posted by: admin April 23, 2020 Leave a comment

Questions:

This is what I’m trying to do with my current code

And here is my excel https://drive.google.com/file/d/0B1GLuBx-ROnhRExUM2xVbG1WOTQ/edit?usp=sharing

The loop checks if the part level indicates it is a parent assembly (the level is lower than the one beneath). Then it sums all the child parts/assemblies Unit Weights below it ( a child part has no other parts beneath it). I don’t have much programming experience, so I’m not sure why this isn’t working or if its even the best approach.

``````Sub UpdateUnitWeight()
Const StartRow = 2
Dim oRng As Range ' Range to work on
Dim oRngSP As Range ' Range for SumProduct
Dim lRows As Long ' Counter
' Start from row "StartRow"
Set oRng = ThisWorkbook.Worksheets("Sheet1").Cells(StartRow, "A")
'Set oRng = ThisWorkbook.Worksheets("Sheet1").Range("A3")
' Loop on numeric cells from StartRow
Do Until IsEmpty(oRng) Or Not IsNumeric(oRng)
lRows = 0 ' Extra Rows belonging to current level
' find how many rows while value on row beneath greater than current
Set oRngSP = oRng.Offset(lRows + 1, 0)
Do While oRng.Value < oRngSP.Value And IsNumeric(oRngSP)
lRows = lRows + 1
Set oRngSP = oRngSP.Offset(1, 0)
Loop
Set oRngSP = Nothing
' Setup the range for SumProduct
With Range(oRng, oRng.Offset(lRows, 0)).Offset(0, 2) ' Qty column
If oRng.Value = oRngSP.Value - 1 Then
oRng.Offset(0, 5).Formula = "=sumproduct(" & Replace(.Address, "\$", "") & "," & Replace(.Offset(0, 1).Address, "\$", "") & ")"
oRng.Offset(0, 5).Interior.ColorIndex = 15
End If
End With
Debug.Print oRng.Offset(0, 5).Address & vbTab & oRng.Offset(0, 5).Formula
' Move the range to next row
Set oRng = oRng.Offset(1, 0)
Loop
Set oRng = Nothing
``````

End Sub

How to&Answers:

From what I understand, you want a column to store SumProduct of levels that are higher than the current level. Since there is a UnitWeight for Level 1 in your sample (row 5).

``````Sub UpdateUnitWeight()
Const StartRow = 2
Dim oRng As Range ' Range to work on
Dim oRngSP As Range ' Range for SumProduct
Dim lRows As Long ' Counter
' Start from row "StartRow"
Set oRng = ThisWorkbook.Worksheets("Sheet1").Cells(StartRow, "A")
' Loop on numeric cells from StartRow
Do Until IsEmpty(oRng) Or Not IsNumeric(oRng)
lRows = 0 ' Extra Rows belonging to current level
' find how many rows while value on row beneath greater than current
Set oRngSP = oRng.Offset(lRows + 1, 0)
Do While oRng.Value < oRngSP.Value And IsNumeric(oRngSP)
lRows = lRows + 1
Set oRngSP = oRngSP.Offset(1, 0)
Loop
Set oRngSP = Nothing
' Setup the range for SumProduct
With Range(oRng, oRng.Offset(lRows, 0)).Offset(0, 2) ' Qty column
oRng.Offset(0, 5).Formula = "=sumproduct(" & Replace(.Address, "\$", "") & "," & Replace(.Offset(0, 1).Address, "\$", "") & ")"
End With
Debug.Print oRng.Offset(0, 5).Address & vbTab & oRng.Offset(0, 5).Formula
' Move the range to next row
Set oRng = oRng.Offset(1, 0)
Loop
Set oRng = Nothing
End Sub
``````

Sample Output based on yours:

Formulas on the column “UpdateUnitWeight”:

``````\$F\$2    =SUMPRODUCT(C2:C4,D2:D4)
\$F\$3    =SUMPRODUCT(C3,D3)
\$F\$4    =SUMPRODUCT(C4,D4)
\$F\$5    =SUMPRODUCT(C5,D5)
\$F\$6    =SUMPRODUCT(C6:C7,D6:D7)
\$F\$7    =SUMPRODUCT(C7,D7)
\$F\$8    =SUMPRODUCT(C8:C11,D8:D11)
\$F\$9    =SUMPRODUCT(C9,D9)
\$F\$10   =SUMPRODUCT(C10:C11,D10:D11)
\$F\$11   =SUMPRODUCT(C11,D11)
``````

If this is not the correct logic, do you mean if there is a higher level beneath, you sum product until a drop in the level?

SOLUTION

Now that the goal is clear, the approach is slightly different to above. Also recommend you to store the Macro in a Module, not on that Worksheet object.

``````Sub UpdateUnitWeight() ' Solution
Const StartRow = 2
Dim oRng As Range ' Range to work on
Dim oRngTmp As Range ' Temporary Range for checking
Dim sTxt As String ' Temporary string for formula use

' Start from row "StartRow"
Set oRng = ThisWorkbook.Worksheets("Sheet1").Cells(StartRow, "A")
' Process all numeric cells from StartRow
Do Until IsEmpty(oRng) Or Not IsNumeric(oRng)
' Total Weight = Qty * Unit Weight (Level independent, applies to each row)
oRng.Offset(0, 4).FormulaR1C1 = "=rc[-2]*rc[-1]"
' Unit Weight may depend on levels beneath
' Current level should SUM rows below that equals (current level + 1) until same level is met
sTxt = ""
Set oRngTmp = oRng.Offset(lRows + 1, 0)
Do While Not IsEmpty(oRngTmp) And IsNumeric(oRngTmp)
Select Case oRngTmp.Value - oRng.Value
Case 1  ' if test range equals current level + 1, prepare formula (Sum of Total Weight of child)
sTxt = sTxt & "+" & Replace(oRngTmp.Offset(0, 4).Address, "\$", "")
Case 0
Exit Do
End Select
Set oRngTmp = oRngTmp.Offset(1, 0)
Loop
Set oRngTmp = Nothing
' Write the formula into the Unit Weight
If Len(sTxt) > 0 Then oRng.Offset(0, 3).Formula = "=" & sTxt
' Move the range to next row
Set oRng = oRng.Offset(1, 0)
Loop
Set oRng = Nothing
End Sub
``````

Sample Output: