Download The Workbook

Sub Sum_Of_Primary_And_Child_Underlying_Values()

'Declare the workbook Object
Dim Wkb As Workbook
Set Wkb = ActiveWorkbook

'Declare worksheet Object
Dim Sh As Worksheet
Set Sh = Wkb.Sheets("Sheet2")

'Loop variable to define the row number
Dim R As Integer

'Clear the contents of columns F & G
If Sh.Range("G" & Rows.Count).End(xlUp).Row > 3 Then
Sh.Range("F4:G" & Sh.Range("G" & Rows.Count).End(xlUp).Row).ClearContents
End If

'Primary and ChildIds
Dim PID As Integer, CID As Integer, OutputFormula As String
Dim ChildExits As String
Dim FindRng As Range

'External Loop for Column C
For R = 4 To Sh.Range("C" & Rows.Count).End(xlUp).Row
OutputFormula = ""
PID = Sh.Cells(R, 3).Value
OutputFormula = Sh.Cells(R, 4).Address(True, True)
ChildExits = "Yes"
CID = Sh.Cells(R, 5).Value

'Internal Loop for Column E
'It iterates until the completion of Underlying values to child object
Do Until ChildExits = ""
'If primary and child value having equivalent value
If PID = CID Then
Exit Do
End If

'Find the child value in Primary column
Set FindRng = Sh.Range(Cells(3, 3), Cells(Sh.Range("C4").End(xlDown).Row, 3)).Find(What:=CID, _
After:=Sh.Range("C3"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

'If value found then Add the address
If Not FindRng Is Nothing Then
ro = FindRng.Row
OutputFormula = OutputFormula & "+" & Sh.Cells(ro, 4).Address(True, True)
CID = Sh.Cells(ro, 5).Value
End If

'If value doesn't found -- stoping the loop
If FindRng Is Nothing Then
ChildExits = ""
End If
Loop

'Copy the output in 6th column
Sh.Cells(R, 6).Value = "=" & OutputFormula

'Copy the formula in seventh column
Sh.Cells(R, 7).Value = "=FORMULATEXT(F" & R & ")"
Next
'Nullifying the variables
Set Wkb = Nothing
Set Sh = Nothing
OutputFormula = ""

End Sub