MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Links to external workbooks


Posted by Sparkle on February 14, 2002 12:34 PM

I have been going through a bunch of old Excel files, and many ask me to find the workbook that they are linked to -- I am looking for a way to see which cells require the external data. Is there a way that I can see this information?
Thanx


Posted by Barrie Davidson on February 14, 2002 1:20 PM

Sparkle, I've written code that will provide you a listing of linked files and, optionally, a listing of the cells containing links. The listing of cells will be hyperlinked to that cell. I've used this many times and it is a real time saver.

Sub Linked_file_listing()
'Written by Barrie Davidson

Dim FilesLinked As Variant
Dim LinkedFilesCount As Integer
Dim SheetCount As Integer
Dim counter As Integer
Dim FileCounter As Integer
Dim LinkAddress As String
Dim LinkedFileName As String
Dim PositionCounter As Integer
Dim PositionRow As Integer
Dim PositionColumn As Integer
Dim FirstOccurrence As String

Application.ScreenUpdating = False
On Error Resume Next
FilesLinked = ActiveWorkbook.LinkSources
If IsError(FilesLinked(1)) = True Then
MsgBox prompt:="No Links Exist", Buttons:=vbInformation + vbOKOnly
Exit Sub
Else
End If
LinkedFilesCount = UBound(FilesLinked)
Sheets(1).Activate
Sheets.Add
Range("A1").Value = "Current list as of " & Format$(Now(), "mmmm d, yyyy")
Range("A2").Select
FileCounter = 1
Do Until FileCounter > LinkedFilesCount
Selection.Value = "LINKED FILE"
Selection.Offset(1, 0).Value = FilesLinked(FileCounter)
Selection.Offset(0, 1).Select
FileCounter = FileCounter + 1
Loop 'Do Until FileCounter > LinkedFilesCount
If MsgBox("Do you want to list each cell containing a link", vbYesNo, _
"Assante Asset Management Ltd.") = vbNo Then
Range("A2:" & Range("A2").End(xlToRight).Address).Select
Selection.EntireColumn.Select
Selection.EntireColumn.AutoFit
Range("A1").Select
Exit Sub
Else
End If
Range("A4").Select
FileCounter = 1
Do Until FileCounter > LinkedFilesCount
LinkedFileName = ""
PositionCounter = 1
Do Until LinkedFileName = "\"
LinkedFileName = Mid(FilesLinked(FileCounter), Len(FilesLinked(FileCounter)) - PositionCounter, 1)
PositionCounter = PositionCounter + 1
Loop 'Do Until LinkedFileName = "\"
LinkedFileName = Mid(FilesLinked(FileCounter), Len(FilesLinked(FileCounter)) - PositionCounter + 2)
Selection.Value = "LINKED FILE CELL LOCATION(es)"
Selection.Offset(1, 0).Select
Sheets(2).Activate
SheetCount = ActiveWorkbook.Sheets.Count
counter = 2
Do Until counter > SheetCount 'Put hyperlinks to each linked cell
Range("A1").Select
FindAddresses:
If IsError(Cells.Find(What:=LinkedFileName, _
After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate) = True Then
Else
FirstOccurrence = ActiveCell.Address
LinkAddress = "'" & ActiveCell.Worksheet.Name & "'!" & ActiveCell.Address
Sheets(1).Activate
ActiveCell.NumberFormat = "@"
ActiveCell.Value = "'" & LinkAddress
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
LinkAddress
ActiveCell.Offset(1, 0).Select
Sheets(counter).Activate
Cells.Find(What:=LinkedFileName, _
After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Do Until ActiveCell.Address = FirstOccurrence
LinkAddress = "'" & ActiveCell.Worksheet.Name & "'!" & ActiveCell.Address
Sheets(1).Activate
ActiveCell.NumberFormat = "@"
ActiveCell.Value = "'" & LinkAddress
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
LinkAddress
ActiveCell.Offset(1, 0).Select
Sheets(counter).Activate
Cells.Find(What:=LinkedFileName, _
After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Loop 'Do Until ActiveCell.Address = FirstOccurrence
End If
counter = counter + 1
Sheets(counter).Activate
PositionRow = 0
PositionColumn = 0
Loop 'Do Until Counter > SheetCount

'added this to get named ranges
Sheets(1).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Named Range(s)"
ActiveCell.Offset(1, 0).Activate
If ActiveWorkbook.Names.Count = 0 Then
Else
For counter = 1 To ActiveWorkbook.Names.Count
If InStr(ActiveWorkbook.Names(counter), LinkedFileName) <> 0 Then
ActiveCell.Value = """" & ActiveWorkbook.Names(counter).Name _
& """" & " refers to " & ActiveWorkbook.Names(counter)
ActiveCell.Offset(1, 0).Select
End If
Next counter
End If
'end of getting named ranges

FileCounter = FileCounter + 1
Sheets(1).Activate
ActiveCell.Offset(0, 1).End(xlUp).Offset(1, 0).Activate
Loop 'Do Until FileCounter > LinkedFilesCount
Sheets(1).Activate
Range("A2:" & Range("A2").End(xlToRight).Address).Select
Selection.EntireColumn.Select
Selection.EntireColumn.AutoFit
Range("A1").Select
Application.ScreenUpdating = True


End Sub


Regards,
Barrie
Barrie Davidson

Posted by Sparkle on February 14, 2002 3:15 PM

This works very well! Thanx