Trace Dependencies for user defined range and list Source Cell/Dependency Cell in separate sheet - excel

Question

I have a range of cells (user defined) that I want vba to tell me which cell(s) these are linked to.
Every source cell can be linked to 1 or multiple cells.
I have the code so far that it
prompts the user for the range
checks that only 1 row is selected.
counts the amount of cells in the range.
creates a separate sheet to list the dependencies.
I am struggling to have the each source cell listed horizontally and 2 rows below the dependency cell(s).
Option Explicit
Sub ListDependents()
Dim rng As Range
Dim r As Range
Dim cell As Range
Dim n As Long, i As Long
Application.ScreenUpdating = False
'Use InputBox to prompt user for range.
'Test for cancel and a single-cell selection.
Set rng = Application.InputBox( _
Title:="Please select a range", _
Prompt:="Select range", _
Type:=8)
On Error GoTo 0
'Test for cancel.
If rng Is Nothing Then Exit Sub
'Test for single-cell selection.
'Remove comment character if single-cell selection is okay.
If rng.Rows.Count > 1 Then
MsgBox "You’ve selected more than 1 row. Please select contiguous cells per row only."
End If
'rng.Select to confirm selection
MsgBox rng.Address
'count cells to be reviewed for dependencies
For Each cell In rng.Areas
n = n + cell.Cells.Count
Next cell
Sheets.Add().Name = "Dependents"
'add first cell of range in B1, second in C1 etc until end of range
'then add first dependent of first range cell in B3, second in C3 etc
If n > "0" Then
i = 1 + i
Sheets("Depentent Test").Cells(2, i) =
End Sub
Source Sheet
Destination Sheet

Answer 1

Try this. I would suggest replacing my variable names with more useful ones. I haven't included a check that a cell has any dependents which is advisable as otherwise it will probably error.
Sub ListDependents()
Dim rng As Range
Dim r As Range
Dim cell As Range
Dim n As Long, i As Long, j As Long
Application.ScreenUpdating = False
'Use InputBox to prompt user for range.
'Test for cancel and a single-cell selection.
Set rng = Application.InputBox( _
Title:="Please select a range", _
Prompt:="Select range", _
Type:=8)
On Error GoTo 0
'Test for cancel.
If rng Is Nothing Then Exit Sub
'Test for single-cell selection.
'Remove comment character if single-cell selection is okay.
If rng.Rows.Count > 1 Then
MsgBox "You’ve selected more than 1 row. Please select contiguous cells per row only."
End If
'rng.Select to confirm selection
MsgBox rng.Address
Sheets.Add().Name = "Dependents"
'add first cell of range in B1, second in C1 etc until end of range
'then add first dependent of first range cell in B3, second in C3 etc
Dim ra As Range, r1 As Range, r2 As Range
j = 2
For Each ra In rng.Areas
For Each r1 In ra
Cells(1, j) = r1.Address
i = 3
For Each r2 In r1.Dependents
Cells(i, j) = r2.Address
i = i + 1
Next r2
j = j + 1
Next r1
Next ra
End Sub

Answer 2

I found a solution to add the headers above each dependency. I moved the rows down by one to have space for a header and then used offset to match the respective header.
j = 2
For Each ra In rng.Areas
For Each r1 In ra
Cells(2, j) = r1.Address
Cells(1, j) = r1.OffSet(-1, 0).Value
i = 4
For Each r2 In r1.Dependents
Cells(i, j) = r2.Address
Cells(i - 1, j) = r2.OffSet(-1, 0).Value
i = i + 2
Next r2
j = j + 1
Next r1
Next ra