Conditional summation of a multi=level parts list

Here is a screenshot of what I'm trying to do http://i.stack.imgur.com/7guvr.png

And here is my excel https://drive.google.com/file/d/0B1G...it?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'm getting an "out of range error" and i'm not sure why or if this is 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