Dependants and Precendents of Excel VBA

example.xlsm

Function fullAddress(inCell As Range) As String
    fullAddress = Split(inCell.Address(External:=True), "]")(1)
End Function

Function findDepend(ByVal inRange As Range) As String
    Dim sheetIdx As Integer
    sheetIdx = Sheets(inRange.Parent.Name).Index
    
    If sheetIdx = Worksheets.Count Then 'vba bug workaround
        Sheets(sheetIdx - 1).Activate
    Else
        Sheets(Worksheets.Count).Activate
    End If

    Dim inAddress As String, returnSelection As Range
    Dim i As Long, pCount As Long, qCount As Long
    Set returnSelection = Selection
    inAddress = fullAddress(inRange)
    
    Application.ScreenUpdating = False
    With inRange
        .ShowPrecedents
        .ShowDependents
        .NavigateArrow False, 1
        Do Until fullAddress(ActiveCell) = inAddress
            pCount = pCount + 1
            .NavigateArrow False, pCount
            If ActiveSheet.Name <> returnSelection.Parent.Name Then
                Do
                    qCount = qCount + 1
                    .NavigateArrow False, pCount, qCount
                    findDepend = findDepend & fullAddress(Selection) & Chr(13)
                    
                    On Error Resume Next
                    .NavigateArrow False, pCount, qCount + 1
                Loop Until Err.Number <> 0
                .NavigateArrow False, pCount + 1
            Else
                findDepend = findDepend & fullAddress(Selection) & Chr(13)
                
                .NavigateArrow False, pCount + 1
            End If
        Loop
        .Parent.ClearArrows
    End With
    
    With returnSelection
        .Parent.Activate
        .Select
    End With
    
    Sheets(sheetIdx).Activate 'activate original worksheet
End Function


Function findPrecedents(ByVal inRange As Range) As String
    Dim sheetIdx As Integer
    sheetIdx = Sheets(inRange.Parent.Name).Index
    
    If sheetIdx = Worksheets.Count Then 'vba bug workaround
        Sheets(sheetIdx - 1).Activate
    Else
        Sheets(Worksheets.Count).Activate
    End If

    Dim inAddress As String, returnSelection As Range
    Dim i As Long, pCount As Long, qCount As Long
    Set returnSelection = Selection
    inAddress = fullAddress(inRange)
    
    Application.ScreenUpdating = False
    With inRange
        .ShowPrecedents
        .ShowDependents
        .NavigateArrow True, 1
        Do Until fullAddress(ActiveCell) = inAddress
            pCount = pCount + 1
            .NavigateArrow True, pCount
            If ActiveSheet.Name <> returnSelection.Parent.Name Then
                Do
                    qCount = qCount + 1
                    .NavigateArrow True, pCount, qCount
                    findPrecedents = findPrecedents & fullAddress(Selection) & Chr(13)
                    
                    On Error Resume Next
                    .NavigateArrow True, pCount, qCount + 1
                Loop Until Err.Number <> 0
                .NavigateArrow True, pCount + 1
            Else
                findPrecedents = findPrecedents & fullAddress(Selection) & Chr(13)
                
                .NavigateArrow True, pCount + 1
            End If
        Loop
        .Parent.ClearArrows
    End With
    
    With returnSelection
        .Parent.Activate
        .Select
    End With
    
    Sheets(sheetIdx).Activate 'activate original worksheet
End Function

Sub messageBoxCellDependents()
    Dim SelRange As Range
    Set SelRange = Selection
    Dim contentString As String
    contentString = "ok"
    contentString = "Dependants of " & fullAddress(SelRange) & " are:" & vbCrLf & vbCrLf
    MsgBox contentString & findDepend(SelRange) 'show user dependent cells in a pop up message box
End Sub

Sub messageBoxCellPrecedents()
    Dim SelRange As Range
    Set SelRange = Selection
    Dim contentString As String
    contentString = "ok"
    contentString = "Precedents of " & fullAddress(SelRange) & " are:" & vbCrLf & vbCrLf
    MsgBox contentString & findPrecedents(SelRange) 'show user dependent cells in a pop up message box
End Sub