How can I find the hyperlinks referring to the cell in Excel ? Reverse of Hyperlink

Question

Hi I want to find a way to trace back the hyperlinks that are referring to the cells. For Eg: There are 5 random cells in A column referring to D2 cell via hyperlink. So when I go to D2, how can I know what are the cells that are referring to D2.

Your answers are much appreciated.

Thanks.

Answer 1

Detect Specific Hyperlinks

• In column A of one worksheet, tries to find the cells that are linked to cell D2 on another worksheet and writes the addresses of the found cells to the Immediate window.

The Code

Option Explicit

Sub detectHyperlinks()
    
    ' Source
    Const srcName As String = "Sheet1"
    Const srcFirst As String = "A1"
    ' Destination
    Const dstName As String = "Sheet2"
    Const dCellAddress As String = "D2"
    
    ' Define Source Column Range.
    With ThisWorkbook.Worksheets(srcName)
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, .Range(srcFirst).Column).End(xlUp).Row
        Dim rng As Range
        Set rng = .Range(cFirst).Resize(LastRow - .Range(cFirst).Row + 1)
    End With
   
   ' Define Destination Address String.
    Dim dAddr As String
    dAddr = dstName & "!" & dCellAddress
    
    Dim cel As Range    ' Current Cell in Source Range
    Dim sAddr As String ' Source Address String
    
    ' Iterate through cells in Source Column Range.
    For Each cel In rng.Cells
        ' Evaluate if current cell does not contain an error or blank value.
        If Not IsError(cel) And Not IsEmpty(cel.Value) Then
            ' Evaluate if current cell contains a hyperlink.
            If cel.Hyperlinks.Count > 0 Then
                ' Write current cells Sub Address to Source Address String
                ' and remove the "'" and "$" characters.
                sAddr = Replace(cel.Hyperlinks(1).SubAddress, "'", "")
                sAddr = Replace(sAddr, "$", "")
                ' Allowing different case (vbTextCompare), evaluate
                ' if Source and Destination Address Strings are equal.
                If StrComp(sAddr, dAddr, vbTextCompare) = 0 Then
                    ' Do what you need to do with the found cell.
                    ' For example print its address to the Immdediate window.
                    Debug.Print cel.Address
                End If
            End If
        End If
    Next cel

End Sub