VBA to list all external links together with the cells containing the links

[lynnsong986]

Hello,

I need to use VBA to list all external links in a workbook and have the location of the corresponding cells that contain these links listed beside them for reference. I do have codes that generate a list of the external links, but I need it to go one more step further to also give me the location of the cells that hold them as part of the formula in those cells.

Your help is greatly appreicated.
Lynn

 

[carlyuanliu]

The following macro will add a new worksheet to the active workbook, and then will list all links within the active workbook in the new worksheet...

Option Explicit

Sub ListLinks()

    Dim Wks             As Worksheet
    Dim rFormulas       As Range
    Dim rCell           As Range
    Dim aLinks()        As String
    Dim Cnt             As Long

    If ActiveWorkbook Is Nothing Then Exit Sub
   
    Cnt = 0
    For Each Wks In Worksheets
        On Error Resume Next
        Set rFormulas = Wks.UsedRange.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0
        If Not rFormulas Is Nothing Then
            For Each rCell In rFormulas
                If InStr(1, rCell.Formula, "[") > 0 Then
                    Cnt = Cnt + 1
                    ReDim Preserve aLinks(1 To 2, 1 To Cnt)
                    aLinks(1, Cnt) = rCell.Address(, , , True)
                    aLinks(2, Cnt) = "'" & rCell.Formula
                End If
            Next rCell
        End If
    Next Wks
   
    If Cnt > 0 Then
        Worksheets.Add before:=Worksheets(1)
        Range("A1").Resize(, 2).Value = Array("Location", "Reference")
        Range("A2").Resize(UBound(aLinks, 2), UBound(aLinks, 1)).Value = Application.Transpose(aLinks)
        Columns("A:B").AutoFit
    Else
        MsgBox "No links were found within the active workbook.", vbInformation
    End If
   
End Sub

Hope this helps!

Very useful code, thank you! But, it missed some links when I tried on my sheet. I found the following modification necessary.

Some links do not have "[" in its formula, so I added a check for ".xls" to capture all file references. I assume that all such files must be some kind of Excel file, .xls, .xlsm, .xlsb, etc.

            For Each rCell In rFormulas
                If InStr(1, rCell.Formula, "[") > 0 _
                    Or InStr(1, rCell.Formula, ".xls") _
                    Then
                    Cnt = Cnt + 1
                    ReDim Preserve aLinks(1 To 2, 1 To Cnt)
                    aLinks(1, Cnt) = rCell.Address(, , , True)
                    aLinks(2, Cnt) = "'" & rCell.Formula
                End If
            Next rCell