Pages

Saturday, April 19, 2014

Find cells linked to external workbook

Macro to find all cells which are linked to any external workbook-

Sub find_cells_linked_to_external_workbooks()
    Dim extlinks
    Dim j As Long, k As Long
    Dim wkb As Workbook
    Dim rng As Range, cl As Range
    Dim links1 As String
    Dim wk As Worksheet
    Set wkb = Workbooks.Add
    wkb.Sheets(1).Range("a1").Value = "Sheet Name"
    wkb.Sheets(1).Range("b1").Value = "Cell Address"
    wkb.Sheets(1).Range("c1").Value = "Formula"
    wkb.Sheets(1).Range("d1").Value = "External Link"
    k = 2
    extlinks = ThisWorkbook.LinkSources(xlExcelLinks)
    
    For Each wk In ThisWorkbook.Sheets
        On Error Resume Next
        Set rng = wk.UsedRange.SpecialCells(xlCellTypeFormulas)
        
            If Not rng Is Nothing Then
            For j = LBound(extlinks) To UBound(extlinks)
            links1 = Left(extlinks(j), InStrRev(extlinks(j), "\")) & "[" & Right(extlinks(j), Len(extlinks(j)) - InStrRev(extlinks(j), "\"))
                For Each cl In rng
                    If InStr(" " & cl.Formula, links1) > 0 Then
                    wkb.Sheets(1).Range("a" & k).Value = wk.Name
                    wkb.Sheets(1).Range("b" & k).Value = cl.Address
                    wkb.Sheets(1).Range("c" & k).Value = "'" & cl.Formula
                    wkb.Sheets(1).Range("d" & k).Value = extlinks(j)
                    k = k + 1
                    End If
                Next
            Next
        End If
        Set rng = Nothing
    Next

End Sub

No comments:

Post a Comment