List cells containing references to files, i.e. containing formulas with broken links

[vanhunk]

List cells containing references to unavailable files, i.e. containing formulas with broken links

Good day,

I have searched through many posts relating to links but could not any that actually worked for what I am trying to achieve. Some claimed to be able to but did not.

What I am trying to achieve is that whenever I have the situation that broken links exist in a workbook,
the type that would give you an error like illustrated in the attached word file
e.g. in the "Edit Links" dialogue box: "Link4.xls Worksheet A Error:Source not found",
I want to be able to run a macro that would list all the cells that contain references to the "source that is not found",
in the case of the example it would be all cells that contain formulas referencing "Link4.xls".

Regards, vanhunk

[snb]

Sub M_snb()
    For Each lk In ActiveWorkbook.LinkSources
        For Each sh In ActiveWorkbook.Sheets
            For Each it In sh.Cells.SpecialCells(xlCellTypeFormulas, 16)
                If InStr(it.Formula, lk) Then c00 = c00 & vbLf & sh.Name & "!" & it.Address
            Next
       Next
    Next
    
    MsgBox c00
End Sub

[vanhunk]

Hi snb, It doesn't detect the broken links for some or other reason and gives the following error message: It Run-time error '1004': No cells were found. Thanks for the quick response. Regards, vanhunk

[snb]

if any of the sheets doesn't contain at least 1 formula that errors out the macro will stuck at that point.
Easily repaired by:

Sub M_snb()
    on Error Resume next

    For Each lk In ActiveWorkbook.LinkSources
        For Each sh In ActiveWorkbook.Sheets
            For Each it In sh.Cells.SpecialCells(xlCellTypeFormulas, 16)
                If InStr(it.Formula, lk) Then c00 = c00 & vbLf & sh.Name & "!" & it.Address
            Next
       Next
    Next
    
    MsgBox c00
End Sub

[vanhunk]

PROBLEM It does not detect the broken links which are there. There are formulas that refer to workbooks that no longer exist and it does not detect it. Thanks

[snb]

Sub M_snb()
  on Error Resume next

  For Each lk In ActiveWorkbook.LinkSources
    For Each sh In ActiveWorkbook.Sheets
      For Each it In sh.Cells.SpecialCells(xlCellTypeFormulas)
        If InStr(it.Formula, lk) Then 
          if dir(lk)="" then c00 = c00 & vbLf & sh.Name & "!" & it.Address
        end if
      Next
    Next
  Next

  MsgBox c00
End Sub

[vanhunk]

Still not Working: (List cells containing references to files, i.e. containing formulas with broken links) All of the cells contain broken links, i.e. links to a workbook that no longer exists. I want the macro to list the cell addresses of each of these cells. At the moment it does not detect it, even if the formula returns #Ref!. I am trying to attach a document for illustration but can not find the attach file button. Regards, vanhunk

[snb]

Click the 'Go advanced' button below the quick Reply window.
There you will find the paperclip icon to add attachments.

[vanhunk]

Tried that, it doesn't show the paperclip icon

[snb]

Are you sure ?paperclip.jpg

[vanhunk]

Thanks snb I missed the paperclip.

The attached file describes the problem I have better. I hope it will assist in getting a solution. Hopefully it will be possible.

Regards,

vanhunk

[vanhunk]

Hi snb,

The attached file goes with the previous post an has your code in it for illustration of the problem.

Regards,
vanhunk

[vanhunk]

STILL NEED HELP PLEASE

[snb]

There you go:

Sub M_snb()
    On Error Resume Next

    For Each lk In ActiveWorkbook.LinkSources
        If Dir(lk) = "" Then
          For Each sh In ActiveWorkbook.Sheets
             For Each it In sh.Cells.SpecialCells(xlCellTypeFormulas)
                 If InStr(Replace(Replace(it.Formula, "[", ""), "]", ""), lk) Then c00 = c00 & vbLf & sh.Name & "!" & it.Address
             Next
          Next
       End If
    Next
    
    MsgBox c00
End Sub

[vanhunk]

Hi snb,

As always, you've done it again!!! Thank you very much!!!

[vanhunk]

Hi snb, In [vba]InStr(Replace(Replace(it.Formula, "[", ""), "]", ""), lk)[/vba] it removes the "[" and "]" and compare it to lk. What exactly does lk look like if the formula looks like " ='I:\MS Office Know How\Excel\@WORK IN PROGRESS\[Link3.xls]Sheet2'!$E$7 " for example? Regards, vanhunk The following code is the final result of what I was trying to achieve. It adds a sheet to the workbook, listing all of the broken links, with hyperlinks to cells containing the broken links: [vba]Sub ShowAllBrokenLinksInfo() 'Purpose: Identify which cells in which worksheets has broken links, i.e. refers to other workbooks that can no longer be found. 'Requirements: Requires a worksheet to be added to the workbook, named BrokenLinksList Dim aLinks As Variant 'Used to determine if any links exist in the workbook. Dim anyWS As Worksheet 'Used to i.a. page through the existing worksheets in the workbook, 'and used to search through worksheets for links (broken links). Dim anyCell As Range 'Used to search through formula cells for links and broken links. Dim reportWS As Worksheet 'Used for the new or reporting worksheet. Dim nextReportRow As Long 'Used for fixing the next row for inputs into the report sheet. Dim shtName As String 'Used as the reporting sheet for all the links in the document. Dim bWsExists As Boolean 'Used to determine if reporting worksheet already exists. Dim BeginSheet As Worksheet 'Used to capture the worksheet the personal macro is activated from. Dim BeginBook As Workbook 'Used to capture the workbook the personal macro is activated from. Dim anyLink As Object 'Used to determine whether the workbook referred to by the link exists. Application.ScreenUpdating = False 'Switch off screen updating to speed up macro execution. 'The following line names the sheet to be added if not already present. The broken links will be listed in this sheet and will be updated 'every time the macro is executed. This sheet will be referred to as the Report Sheet ("reportWS"): shtName = "BrokenLinksList" 'The following line captures the name of the workbook the macro is activated from and enables the use of the macro from the personal workbook: Set BeginBook = Application.ActiveWorkbook 'The following line determines whether any links exist in the workbook, i.e. in "BeginBook": aLinks = BeginBook.LinkSources(xlExcelLinks) '########################################################################## ######### If Not IsEmpty(aLinks) Then 'i.e. there are links in the workbook and therefore requires us to deal with the next section: '========================================================================== ========= 'THIS SECTION DEALS WITH THE BROKEN LINKS REPORT SHEET: 'The following lines determine whether a broken links report sheet already exists: For Each anyWS In Application.Worksheets 'Page through all the existing sheets in the workbook. If anyWS.Name = shtName Then bWsExists = True 'and compare their names with the selected report sheet name. Next anyWS '----------------------------------------------------------------------------------------------------------------------------------------------------- 'The following lines adds a broken links report sheet if it doesn't already exists: If bWsExists = False Then Application.DisplayAlerts = False 'The following line adds the report sheet for listing of all the broken links, if it does not already exist in the workbook: Set anyWS = ActiveWorkbook.Worksheets.Add(Type:=xlWorksheet) 'Adds new sheet (the report sheet) anyWS.Name = shtName 'Changes its name to the selected report sheet name. anyWS.Select 'Selects the new sheet (report sheet). anyWS.Move After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count) 'Moves it to the last "tab" position. Application.DisplayAlerts = True End If '----------------------------------------------------------------------------------------------------------------------------------------------------- 'The following lines prepare the report sheet and add headings to the columns: Set reportWS = BeginBook.Worksheets(shtName) reportWS.Cells.Clear reportWS.Range("A1") = "Worksheet" reportWS.Range("B1") = "Cell" reportWS.Range("C1") = "Formula" 'End of the section that deals directly with the links report sheet. '========================================================================== ========= '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& &&&&&&&&& 'THIS SECTION DEALS DIRECTLY WITH THE LINKS AND BROKEN LINKS IN THE WORKBOOK: On Error Resume Next '.......................................................................... ........................................................................... ....................................... For Each anyLink In ActiveWorkbook.LinkSources 'Loops through all the link sources for the workbook. '------------------------------------------------------------------------------------------------------------------------------------------------------- If Dir(anyLink) = "" Then 'If the workbook referenced by the link is not found then continue: '========================================================================== ========== For Each anyWS In ActiveWorkbook.Sheets 'Loop through all the sheets in the workbook to find the links. '************************************************************************** ********************* For Each anyCell In anyWS.Cells.SpecialCells(xlCellTypeFormulas) 'Loops through all formulas in the worksheet. '""""""""""""""""""""""""""""""""""""""""""""""""""""""""""'''''''''''''''' ''''''''''''''''''''''''''''''""""""""""""""""""""""""""""""""""""""""""""" """"""""""""""""""""" 'The following line removes the "[" and "]" characters and compares the result with "anylink": If InStr(Replace(Replace(anyCell.Formula, "[", ""), "]", ""), anyLink) Then 'The following line checks whether the sheet contains any links: If Not InStr(anyCell.Formula, "[") > 0 Then GoTo VolgendeSheet nextReportRow = reportWS.Range("A" & Rows.Count).End(xlUp).Row + 1 reportWS.Range("A" & nextReportRow) = anyWS.Name reportWS.Range("B" & nextReportRow) = anyCell.Address reportWS.Range("C" & nextReportRow) = "'" & anyCell.Formula 'The following lines add hyperlinks to the cell address items of the report: With reportWS .Hyperlinks.Add _ Anchor:= _ .Range("B" & nextReportRow), _ Address:= _ "", _ SubAddress:= _ "'" & anyWS.Name & "'!" & anyCell.Address, _ ScreenTip:= _ "GOTO Linked Cell" End With 'The following lines format the headings of the report: With reportWS.Range("A1:C1") .Font.Bold = True .HorizontalAlignment = xlCenter .Font.Size = 11 End With reportWS.Range("B1").End(xlDown).Font.Size = 10 reportWS.Columns("A:C").EntireColumn.AutoFit End If 'End of "InStr(Replace(Replace(anyCell.Formula, "[", ""), "]", ""), anyLink)" '''''''''''''''''''''''''''''''''''''''''"""""""""""""""""""""""""""""""""" """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" """"""""""""""" Next 'Next anyCell in anyWS.Cells.SpecialCells(xlCellTypeFormulas) '************************************************************************** ******************* VolgendeSheet: Next 'Next anyWS in ActiveWorkbook.Sheets '========================================================================== ========= End If 'End of "If Dir(anyLink) = "" '----------------------------------------------------------------------------------------------------------------------------------------------------- Next 'Next anyLink In ActiveWorkbook.LinkSources" '.......................................................................... ........................................................................... ..................................... 'END OF SECTION THAT DEALS DIRECTLY WITH THE LINKS AND BROKEN LINKS IN THE WORKBOOK. '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& &&&&&&&&& Else 'Part of In Not IsEmpty(aLinks) block. Else it is empty, i.e. there are no links in workbook. MsgBox "No links to Excel worksheets detected." End If 'End of If Not IsEmpty(aLinks) block '########################################################################## ######### 'Housekeeping: Set reportWS = Nothing Set anyWS = Nothing Set anyCell = Nothing Application.ScreenUpdating = True End Sub[/vba]

[snb]

Use the local window to identify the value of a certain variable.
Use F8 to go through the macro step by step.

Your code in the previous post isn't readable.
I think you should remove all hyphens.

[vanhunk]

Hi snb,

I tried your suggestion and what seemed like everything else, but could not load the code in such a way that the posted code stays in its original format. I have no idea what else to try.

I have now opted to post the code as a Word attachment.

Once again, thank you for your assistance.

Regards,
vanhunk

[snb]

Why do you consider a worksheet to be an element of Excel instead of a workbook ?

For Each anyWS In Application.Worksheets

should be


For Each anyWS In thisworkbook.Worksheets

or

For Each anyWS In activeworkbook.Worksheets

or

For Each anyWS In workbooks(2).Worksheets

or

For Each anyWS In workbooks("workbookName.xlsx").Worksheets

[snb]

Sub M_snb()
   if not evaluate("isref(" & shtName &"!A1)") then 
       thisworkbook.sheets.add ,thisworkbook.sheets.count
       thisworkbook.sheets(thisworkbook.sheets.count).name=shtname
   end if
End Sub

can replace
For Each anyWS In Application.Worksheets 'Page through all the existing sheets in the workbook.
If anyWS.Name = shtName Then bWsExists = True 'and compare their names with the selected report sheet name.
Next anyWS
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'The following lines adds a broken links report sheet if it doesn't already exists:
If bWsExists = False Then
Application.DisplayAlerts = False
'The following line adds the report sheet for listing of all the broken links, if it does not already exist in the workbook:
Set anyWS = ActiveWorkbook.Worksheets.Add(Type:=xlWorksheet) 'Adds new sheet (the report sheet)
anyWS.Name = shtName 'Changes its name to the selected report sheet name.
anyWS.Select 'Selects the new sheet (report sheet).
anyWS.Move After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count) 'Moves it to the last "tab" position.
Application.DisplayAlerts = True
End If