Excel: Finding broken links

Sometimes when you open an Excel file, it refers out to another random Excel file that doesn't exist and then Excel stops loading the file to ask you what to do:

There's multiple places where Excel can store links to other files, and it requires some additional work to identify them all.

Here are the steps you need to follow: https://professor-excel.com/break-links-in-excel-all-of-them/

In short:

1. Break ‘normal’ workbook links within formulas

2. Break links from named ranges

3. Break Data Validation links

4. Break links of Conditional Formatting rules

5. Break links of Pivot Tables

To get a report of broken links in formulas (and optionally remove them), use this modified macro from https://www.ablebits.com/office-addins-blog/excel-find-fix-broken-links/ . Note that this doesn't check for broken links in Pivot Tables yet.

Sub FindBrokenLinks()

' https://www.ablebits.com/office-addins-blog/excel-find-fix-broken-links/

' Updated to also report data validation, name, and conditional formatting errors

' Edward Chan 2023

' This macro requires CPearson's array functions http://www.cpearson.com/Excel/VBAArrays.htm

  Dim reportHeaders() As String

  Dim rangeCur As Range

  Dim sheetCur As Worksheet

  Dim rowNo As Long

  Dim linkFilePath, linkFilePath2, linkFileName As String

  Dim linksStatusDescr As String  'https://docs.microsoft.com/en-us/office/vba/api/excel.xllinkstatus

  Dim sheetReportName As String

  Dim autoFix As VbMsgBoxResult

  Dim cell As Range

  Dim linksString As String

  Dim badLinks As String

  Dim manuallyFix As Boolean ' Track if there are manual fixes to alert

  Dim workBookToFix As Workbook

  Dim linksdataArrayEmpty As Boolean

  Dim wbNames As String

  Dim SheetToMod As Range

  Dim wb As Workbook

  ' Select a workbook

  c = 0

  wbNames = ""

  For Each wb In Application.Workbooks

    c = c + 1 ' workbook number

    If wb.Name <> ThisWorkbook.Name And wb.Windows(1).Visible = True Then

      wbNames = wbNames & vbLf & c & ". " & wb.Name

      d = d + 1 ' number of workbooks that appear

      E = wb.Name ' name of workbook

    End If

  Next wb

  If d = 0 Then ' No other workbooks open

    Temp = MsgBox("Please open another Excel Workbook to fix", vbOKOnly)

    Exit Sub

  ElseIf d = 1 Then ' 1 other workbook open, choose this one

    Set workBookToFix = Application.Workbooks(E) ' There's only 1 other workbook so pick this one

  Else ' More than 1 workbook open, ask the user.

    workbookNumber = 0

    On Error Resume Next

    workbookNumber = InputBox("Type the number of the workbook you want to analyse" & Chr(10) & wbNames, "Find Broken Links")

    If workbookNumber = 0 Then Exit Sub

    Set workBookToFix = Workbooks(CInt(workbookNumber))

    If workBookToFix Is Nothing Then Exit Sub ' User typed in a bad number

    If workBookToFix.Windows(1).Visible = False Then Exit Sub ' User chose invisible window

    If workBookToFix.Name = ThisWorkbook.Name Then Exit Sub ' User chose macro

    On Error GoTo 0

  End If

  workBookToFix.Activate

  autoFix = MsgBox("Find Broken Links: Do you wish to fix the problems automatically in " & workBookToFix.Name & "?", vbYesNoCancel + vbDefaultButton2)

  If autoFix = vbCancel Then Exit Sub

  manuallyFix = False ' Track if there are manual fixes to alert

  sheetReportName = "Broken Links report"

  linksdataArray = workBookToFix.LinkSources(xlExcelLinks)

  linksdataArrayEmpty = IsArrayEmpty(linksdataArray)

  linksStatusDescr = "File missing"

  reportHeaders = Split("Worksheet,Cell,Formula,Workbook,Link Status,Fix", ",")

  rowNo = 1 'Header row

  Application.ScreenUpdating = True

'  Application.ScreenUpdating = False

  calcState = Application.Calculation

  Application.Calculation = xlCalculationManual

  If Evaluate("ISREF('" & sheetReportName & "'!A1)") Then

    workBookToFix.Worksheets(sheetReportName).Cells.Clear

  Else

    workBookToFix.Worksheets.Add.Name = sheetReportName

  End If

  Set sheetreport = workBookToFix.Worksheets(sheetReportName)

  For indI = 0 To UBound(reportHeaders)

    sheetreport.Cells(rowNo, indI + 1) = reportHeaders(indI)

  Next

  Application.DisplayAlerts = False

  ' Check for bad named ranges

  For Each namedrangeCur In Names

'Debug.Print namedrangeCur

    linkFilePath = ""

    linksStatusCode = -1

    missing = False

  ' Check if the links are used. NOTE: If the file is actually open, then Excel will strip the file path! So you need to do two checks.

  Dim found As Range

  If linksdataArrayEmpty = False Then

    For indI = LBound(linksdataArray) To UBound(linksdataArray)

      linkFilePath = linksdataArray(indI)   'LinkSources returns the full file path with the file name

      linkFileName = Right(linkFilePath, Len(linkFilePath) - InStrRev(linkFilePath, "\"))   'extract only the file name

      linkFilePath2 = Left(linksdataArray(indI), InStrRev(linksdataArray(indI), "\")) & "[" & linkFileName & "]"  'the file path with the workbook name in square brackets

      missing = True

      ' Check if the full file path is there

      For Each sheetCur In workBookToFix.Worksheets

        Set found = sheetCur.Cells.Find(What:=linkFilePath2, After:=sheetCur.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _

        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

        , SearchFormat:=False)

        If Not (found Is Nothing) Then

          missing = False

          Exit For

        End If

      Next sheetCur

      ' Check if the file is open already, if so then assume its not missing.

      If IsWorkbookOpen(linkFileName) Then missing = False

      If missing = True Then

        rowNo = rowNo + 1

        With sheetreport

          .Cells(rowNo, 1) = "N/A"

          .Cells(rowNo, 2) = "N/A"

          .Cells(rowNo, 3) = linkFilePath2

          .Cells(rowNo, 5) = "Link not used in Data > Edit Links"

        End With

        If autoFix = vbYes Then

          workBookToFix.BreakLink Name:=linkFilePath, Type:=xlLinkTypeExcelLinks

          sheetreport.Cells(rowNo, 6) = "Deleted"

        Else

          sheetreport.Cells(rowNo, 6) = "Not Fixed"

        End If

      End If

    Next indI

    Application.ScreenUpdating = True

  End If

    ' Check for #REF errors first

    If 0 < InStr(namedrangeCur.Name, "!") Then ' Ignore Custom Views

      missing = False

    ElseIf 0 < InStr(namedrangeCur.RefersTo, "#REF!") Then

      missing = True

      linksStatusDescr = "#REF! Error"

      linkFilePath = "No Workbook referenced"

    End If

'    On Error Resume Next

'    missing = True

'    Check = Len(namedrangeCur.RefersToRange) ' Check if it doesn't resolve at all

'    On Error GoTo 0

    ' Check named ranges are good

    If 0 < InStr(namedrangeCur.RefersTo, "[") Then

      ' LinkInfo is too slow if there are a lot to check, just check each link once

      linkFilePath = Replace(Split(Right(namedrangeCur.RefersTo, Len(namedrangeCur.RefersTo) - 2), "]")(0), "[", "")

      If 0 = InStr(linksString, linkFilePath) Then ' We haven't checked this link yet

        sheetreport.Cells(rowNo + 1, 1) = "Please wait, checking link " & linkFilePath

        sheetreport.Activate

        sheetreport.Cells(rowNo + 1, 1).Activate

        sheetreport.Cells(rowNo + 1, 1).Select

        DoEvents

        DoEvents

        linksStatusCode = workBookToFix.LinkInfo(CStr(linkFilePath), xlLinkInfoStatus)

        sheetreport.Cells(rowNo + 1, 1) = ""

        linksString = linksString & linkFilePath ' Append the new link to avoid double-checking because checking is slow

        If xlLinkStatusMissingFile = CInt(linksStatusCode) Then

          missing = True

          badLinks = badLinks & linkFilePath

          linksStatusDescr = "File Missing"

        End If

      Else ' It's been checked, see if it was bad

        If 0 < InStr(badLinks, linkFilePath) Then

          missing = True

          linksStatusDescr = "File Missing"

        End If

      End If

    End If

    If missing = True Then

      rowNo = rowNo + 1

      With sheetreport

        .Cells(rowNo, 1) = "Name Manager"

        .Cells(rowNo, 2) = namedrangeCur.Name

        .Cells(rowNo, 3) = "'" & namedrangeCur.Value

        .Cells(rowNo, 4) = linkFilePath

        If 0 < Len(linkFilePath) Then

           .Cells(rowNo, 5) = linksStatusDescr

        End If

        .Activate

        .Cells(rowNo, 1).Activate

        .Cells(rowNo, 1).Select

        DoEvents

       End With

      If autoFix = vbYes Then

        sheetreport.Cells(rowNo, 6) = "Manually Fix (Formulas > Name Manager > Value: #REF! or {..})"

        manuallyFix = True

'        V = 0

'        On Error Resume Next ' If the sheet is protected this will fail

'        namedrangeCur.Delete

'        V = Len(cell.namedrangeCur.Name)

'        On Error GoTo 0

'        If V = 0 Then

'          sheetreport.Cells(rowNo, 6) = "Deleted Name"

'        Else

'          sheetreport.Cells(rowNo, 6) = "Failed, check if sheet is protected"

'        End If

      Else

        sheetreport.Cells(rowNo, 6) = "Not Fixed"

      End If

    End If

  Next namedrangeCur

  Dim formulaCells As Range

  For Each sheetCur In workBookToFix.Worksheets

    Set formulaCells = Nothing ' To avoid error if there are no formulas

    If sheetCur.Name <> sheetreport.Name Then

      ' Check formulas

      On Error Resume Next ' To avoid error if there are no formulas

      Set formulaCells = sheetCur.Cells.SpecialCells(xlCellTypeFormulas)

      On Error GoTo 0 ' To avoid error if there are no formulas

      If Not (formulaCells Is Nothing) Then

        For Each rangeCur In formulaCells

'          Debug.Print sheetCur.Name & " " & rangeCur.Address

          If linksdataArrayEmpty = False Then

            For indI = LBound(linksdataArray) To UBound(linksdataArray)

              missing = False

              linkFilePath = linksdataArray(indI)   'LinkSources returns the full file path with the file name

              linkFileName = Right(linkFilePath, Len(linkFilePath) - InStrRev(linkFilePath, "\"))   'extract only the file name

              linkFilePath2 = Left(linksdataArray(indI), InStrRev(linksdataArray(indI), "\")) & "[" & linkFileName & "]"  'the file path with the workbook name in square brackets

              If 0 = InStr(linksString, linkFilePath) Then ' We haven't checked this link yet

                sheetreport.Cells(rowNo + 1, 1) = "Please wait, checking link " & linkFilePath

                sheetreport.Activate

                sheetreport.Cells(rowNo + 1, 1).Activate

                sheetreport.Cells(rowNo + 1, 1).Select

                DoEvents

                DoEvents

                linksStatusCode = workBookToFix.LinkInfo(CStr(linkFilePath), xlLinkInfoStatus)

                sheetreport.Cells(rowNo + 1, 1) = ""

                linksString = linksString & linkFilePath ' Append the new link to avoid double-checking because checking is slow

                If xlLinkStatusMissingFile = CInt(linksStatusCode) Then

                  badLinks = badLinks & linkFilePath

                End If

                If xlLinkStatusMissingFile = CInt(linksStatusCode) And (InStr(rangeCur.Formula, linkFilePath) Or InStr(rangeCur.Formula, linkFilePath2)) Then

                  missing = True

                  linksStatusDescr = "File Missing"

                End If

              Else ' It's been checked, see if it was bad

                If 0 < InStr(badLinks, linkFilePath) And (InStr(rangeCur.Formula, linkFilePath) Or InStr(rangeCur.Formula, linkFilePath2)) Then

                  missing = True

                  linksStatusDescr = "File Missing"

                End If

              End If

              If missing = True Then

                rowNo = rowNo + 1

                With sheetreport

                  .Cells(rowNo, 1) = sheetCur.Name

                  .Cells(rowNo, 2) = Replace(rangeCur.Address, "$", "")

                  .Hyperlinks.Add Anchor:=.Cells(rowNo, 2), Address:="", SubAddress:="'" & sheetCur.Name & "'!" & rangeCur.Address

                  .Cells(rowNo, 3) = "'" & rangeCur.Formula

                  .Cells(rowNo, 4) = linkFilePath

                  .Cells(rowNo, 5) = linksStatusDescr

                  If rowNo Mod 20 = 0 Then

                    .Activate

                    .Cells(rowNo, 1).Select

                    DoEvents

                  End If

                End With

                ' Manually fix because it's possible to refactor the link

                If autoFix = vbYes Then

                  sheetreport.Cells(rowNo, 6) = "Manually Fix (Data > Edit Links)"

                  manuallyFix = True

  '                If sheetCur.ProtectContents = True Then

  '                  sheetreport.Cells(rowNo, 6) = "Failed, check if sheet is protected"

  '                Else

  '                  rangeCur.Copy

  '                  sheetCur.Activate

  '                  rangeCur.Select

  '                  rangeCur.PasteSpecial (xlPasteValues)

  '                  sheetreport.Cells(rowNo, 6) = "Made cell static"

  '                End If

                Else

                  sheetreport.Cells(rowNo, 6) = "Not Fixed"

                End If

              End If

            Next indI

          End If

'          For Each namedrangeCur In Names

'             If InStr(rangeCur.Formula, namedrangeCur.Name) Then

'              linkFilePath = ""

'              linksStatusCode = -1

'

'              If 0 < InStr(namedrangeCur.RefersTo, "[") Then

'                linkFilePath = Replace(Split(Right(namedrangeCur.RefersTo, Len(namedrangeCur.RefersTo) - 2), "]")(0), "[", "")

'                linksStatusCode = workBookToFix.LinkInfo(CStr(linkFilePath), xlLinkInfoStatus)

'              End If

'              If xlLinkStatusMissingFile = linksStatusCode Then

'                rowNo = rowNo + 1

'                 With sheetReport

'                   .Cells(rowNo, 1) = sheetCur.Name

'                   .Cells(rowNo, 2) = Replace(rangeCur.Address, "$", "")

'                   .Hyperlinks.Add Anchor:=.Cells(rowNo, 2), Address:="", SubAddress:="'" & sheetCur.Name & "'!" & rangeCur.Address

'                   .Cells(rowNo, 3) = "'" & rangeCur.Formula

'                   .Cells(rowNo, 4) = linkFilePath

'                   If 0 < Len(linkFilePath) Then

'                  .Cells(rowNo, 5) = linksStatusDescr

'                   End If

'                 End With

'              End If

'              Exit For

'            End If

'          Next namedrangeCur

        Next rangeCur

      End If

      ' Check for bad data validation links

      ' Note: Can't use special cells if sheet is protected

      Set validatedcells = Nothing

      If sheetCur.ProtectContents = True Then

        rowNo = rowNo + 1

        With sheetreport

          .Cells(rowNo, 1) = sheetCur.Name

          .Cells(rowNo, 2) = "N/A"

          .Cells(rowNo, 3) = "N/A"

          .Cells(rowNo, 4) = "N/A"

          .Cells(rowNo, 5) = "Data Validation: Cannot check, sheet is protected"

          If rowNo Mod 20 = 0 Then

            .Activate

            .Cells(rowNo, 1).Select

            DoEvents

          End If

        End With

      End If

      On Error Resume Next ' To get around the error when no validated cells are found

      Set validatedcells = sheetCur.Cells.SpecialCells(xlCellTypeAllValidation)

      On Error GoTo 0

      If Not (validatedcells Is Nothing) Then ' Check if any validated cells found

        For Each cell In validatedcells

          On Error Resume Next ' Sometimes SpecialCells returns more than just cells with Data Validation

          validationlength = 0

          validationlength = cell.Validation.Formula1

          On Error GoTo 0

          If validationlength <> 0 Then

            If InStr(cell.Validation.Formula1, "#REF") > 0 Then

              'Debug.Print sheetCur.Name & " " & cell.Address & cell.Validation.Formula1

              linkFilePath = Replace(Split(Right(cell.Validation.Formula1, Len(cell.Validation.Formula1) - 2), "]")(0), "[", "")

              rowNo = rowNo + 1

              With sheetreport

                .Cells(rowNo, 1) = sheetCur.Name

                .Cells(rowNo, 2) = Replace(cell.Address, "$", "")

                .Hyperlinks.Add Anchor:=.Cells(rowNo, 2), Address:="", SubAddress:="'" & sheetCur.Name & "'!" & cell.Address

                .Cells(rowNo, 3) = "'" & cell.Validation.Formula1

                .Cells(rowNo, 4) = linkFilePath

                .Cells(rowNo, 5) = "Data Validation: Cannot find file"

                If rowNo Mod 20 = 0 Then

                  .Activate

                  .Cells(rowNo, 1).Select

                  DoEvents

                End If

              End With

              If autoFix = vbYes Then

                On Error Resume Next ' If the sheet is protected this will fail

                cell.Validation.Delete

                DVType = cell.Validation.Type

                On Error GoTo 0

                If DVType = 3 Then

                  sheetreport.Cells(rowNo, 6) = "Failed, check if sheet is protected"

                Else

                  sheetreport.Cells(rowNo, 6) = "Deleted Data Validation"

                End If

              Else

                sheetreport.Cells(rowNo, 6) = "Not Fixed"

              End If

            End If

          End If

        Next ' data validated cell

      End If ' end check if no data validated cells

      ' Look for bad Conditional Formatting

      Dim cf As FormatCondition

'      Dim wb As Workbook

      Dim i As Long, j As Long

      Set cf = Nothing

      For j = sheetCur.UsedRange.FormatConditions.Count To 1 Step -1 ' Go backwards so you can delete the last one without affecting the next

        On Error Resume Next

        Set cf = sheetCur.UsedRange.FormatConditions(j)

        On Error GoTo 0

        If Not (cf Is Nothing) Then

          If cf.Type = xlExpression And InStr(1, cf.Formula1, "[") > 0 Then

            linkFilePath = Replace(Split(Right(cf.Formula1, Len(cf.Formula1) - 2), "]")(0), "[", "")

            linkFilePath = Split(linkFilePath, "'")(1)

            rowNo = rowNo + 1

            With sheetreport

              .Cells(rowNo, 1) = sheetCur.Name

              .Cells(rowNo, 2) = Replace(cf.AppliesTo.Address, "$", "")

              .Hyperlinks.Add Anchor:=.Cells(rowNo, 2), Address:="", SubAddress:="'" & sheetCur.Name & "'!" & cf.AppliesTo.Address

              .Cells(rowNo, 3) = "'" & cf.Formula1

              .Cells(rowNo, 4) = linkFilePath

              .Cells(rowNo, 5) = "Conditional Formatting: External file reference"

              If rowNo Mod 20 = 0 Then

                .Activate

                .Cells(rowNo, 1).Select

                DoEvents

              End If

            End With

            If autoFix = vbYes Then

              On Error Resume Next ' If the sheet is protected this will fail

              cf.Delete

              V = 0

              V = cell.SpecialCells(xlCellTypeAllFormatConditions).Count

              On Error GoTo 0

              If V = 0 Then

                If sheetCur.ProtectContents = True Then

                  ' Sometimes it will delete the conditional format even if sheet is protected, but you can't be sure even if you count.

                  sheetreport.Cells(rowNo, 6) = "Attempted to delete on protected sheet, this may not have worked"

                Else ' It's not protected

                  sheetreport.Cells(rowNo, 6) = "Deleted, close and reopen to update"

                End If

              Else

                sheetreport.Cells(rowNo, 6) = "Failed, check if sheet is protected"

              End If

            Else

              sheetreport.Cells(rowNo, 6) = "Not Fixed"

            End If

          End If

        End If

      Next j

    End If

    ' Because it's slow, do a screen update every sheet

    sheetreport.Activate

    sheetreport.Cells(rowNo, 1).Select

    DoEvents

  Next sheetCur

  If rowNo = 1 Then

    sheetreport.Delete

    Temp = MsgBox("Good job – no broken links found!!", vbOKOnly, "Find Broken Links")

    Application.Calculation = calcState

    Exit Sub

  End If

  Columns("A:F").EntireColumn.AutoFit

  Columns("C:C").ColumnWidth = 30

  If Columns("B:B").ColumnWidth > 15 Then Columns("B:B").ColumnWidth = 15

  If Columns("D:D").ColumnWidth > 20 Then Columns("D:D").ColumnWidth = 20

  If Columns("E:E").ColumnWidth > 20 Then Columns("E:E").ColumnWidth = 20

  If Columns("F:F").ColumnWidth > 30 Then Columns("F:F").ColumnWidth = 30

  Columns("A:C").Select

  Columns("A:F").HorizontalAlignment = xlGeneral

  Columns("A:F").VerticalAlignment = xlTop

  Columns("A:F").WrapText = True

  sheetreport.Activate

  DoEvents

  sheetreport.Range("A1").Select

  ActiveWindow.ScrollRow = 1

  ActiveWindow.ScrollColumn = 1

  ActiveWindow.SplitColumn = 0

  ActiveWindow.SplitRow = 1

  ActiveWindow.FreezePanes = True

  Rows("1:1").Font.Bold = True

  ActiveWindow.ScrollRow = 1

  ActiveWindow.ScrollColumn = 1

  Application.ScreenUpdating = True

  Application.DisplayAlerts = True

  Application.Calculation = xlCalculationAutomatic

  If manuallyFix = True Then

    Temp = MsgBox("Not all problems can be automatically fixed. " & Chr(10) & "See the Fix column for the steps you can take to fix these manually.", vbOKOnly)

  End If

  Application.Calculation = calcState

End Sub

Function IsWorkbookOpen(wbName As String) As Boolean

    Dim wb As Workbook

    On Error Resume Next

    Set wb = Workbooks(wbName)

    If wb Is Nothing Then

        IsWorkbookOpen = False

    Else

        IsWorkbookOpen = True

    End If

End Function