Home > Net >  Trace Dependencies for user defined range and list Source Cell/Dependency Cell in separate sheet
Trace Dependencies for user defined range and list Source Cell/Dependency Cell in separate sheet

Time:03-17

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 Source Sheet Destination Sheet Destination Sheet

CodePudding user response:

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
  • Related