Reputation: 1
My first post, so please go easy on me...
Looking to do a loop in VBA that looks at all formulas that contain an external workbook reference, and remove them so that the formula looks to the same sheet name in the current workbook instead.
For example:
-Workbook "A" has sheet names "1", "2", and "3". there are formulas on sheet "1" referring to cells in "2" and "3". -I then made a copy of [Workbook"A", Sheet "1"] to Workbook "B" which already has sheets "2" and "3" with data of it's own (in the same format). -I want to create a button so that I can remove the "'A'!" link to the original workbook that will inevitably show up in every one of the formulas in workbook "B" after the copy.
I know you can do a 'find and replace' for a similar result, but the way things are this will need to be done a couple hundred times on different workbooks, and was looking for a faster way (like put this in my personal macro-enabled workbook and make a button to do this for any currently open workbooks).
Currently I have:
Private Sub CommandButton1_Click()
Dim aw As Worksheet
Dim wb As Workbook
Dim b As String
Dim r As Long
Dim c As Long
Dim s As String
Dim k As String
Dim l As String
On Error Resume Next
With ActiveWorkbook.Sheets("Sheet1")
For c = 1 To 20
For r = 1 To 20
b = Cells(r, c).Formula
s = "'J:\MPS020000 work order cost detailed transactions\Work order cost files.xlsx'!"
k = ""
k = Replace(b, s, k)
l = k
If b = k Then
Else
Sheets("Sheet1").Range("A1").Offset((r - 1), (c - 1)).Formula = k
End If
On Error Resume Next
Next r
Next c
End With
End Sub
Problem is I keep getting "run-time error 1004: application-defined or object-defined error"
Please help!
Upvotes: 0
Views: 1493
Reputation: 234
Surprisingly hard to find given how convenient this is. This will change all references pointing at one excel file to point at the same sheet/cell reference but in the current file:
Sub ReLink()
ThisWorkbook.ChangeLink <<THE PATH YOU WANT REMOVED E.G. "C:\Users\User\MyFile.xlsx">>, _
ThisWorkbook.FullName, xlExcelLinks
End Sub
This will raise an error if there are no links pointing at the path you want removed. Also, you will get a reference error in the cells if the same sheet/cell reference doesn't exist in the current workbook. You might need to account for this in your code.
Let me know how it works out!
Edit
I re-read your question, properly this time, and by my own admission have gotten a bit carried away...
This is the new Sub. It should give you a bit more detail as to why it wasn't working for you last time. I suspect it might have been pointing at a different workbook than you expected, but we shall see...!
Sub UpdateExternalLinks(LinkToUpdate As String, Optional NewLink As String, Optional ByVal Workbook As Workbook)
' Update external links in a single workbook
' Args:
' LinkToUpdate - The "old" source. The path to the external Excel file which is being linked to
' NewLink (Optional) - Path to Excel file with which to replace "old" source. _
- If not provided, defaults to reference workbook holding links.
' WorkBook (Optional) - A VBA Workbook Object of the Excel file which contains the external links (the file we want to modify) _
- If not provided, defaults to the "Active" workbook
' If no workbook specified, assume we're looking for links in the Active Workbook
If IsEmpty(Workbook) Then
Workbook = ActiveWorkbook
End If
Debug.Print "Searching for links in " & Workbook.FullName
' If no replacement external link provided, replace external link with workbook link
If NewLink = "" Then
NewLink = Workbook.FullName
End If
Links = Workbook.LinkSources()
' Check any links were found (will error when trying to loop otherwise)
If IsEmpty(Links) Then
Debug.Print ("No external links found.")
Debug.Print
Exit Sub
End If
' Check we have at least one link we wish to update
MatchingLinksFound = False
For Each LinkSource In Links
If LinkSource = LinkToUpdate Then
MatchingLinksFound = True
Exit For
End If
Next LinkSource
If Not MatchingLinksFound Then
Debug.Print ("No external links found matching provided path")
Debug.Print
Exit Sub
End If
' Do the update
Workbook.ChangeLink LinkToUpdate, _
NewLink, xlExcelLinks
Debug.Print "Links updated"
Debug.Print
End Sub
You can run it like this:
Sub DoUpdate()
UpdateExternalLinks LinkToUpdate:="C:\Users\User\Random\FakeData.xlsx"
End Sub
But now for the "carried-away" part. I wrote another Sub, which uses the one above, and allows you to update the links in a bunch of separate files- in this instance, all the Excel (*.xlsx) files in a particular folder.
Warning: This script will save changes if it finds an external link. It would be a good idea to back-up your files before running it.
Sub UpdateExternalLinksInDirectory(DirectoryToSearch As String, LinkToUpdate As String, Optional NewLink As String)
' Create a new instance of excel
Dim objExcel
Set objExcel = CreateObject("Excel.Application")
' Hide the new instance
objExcel.Visible = False
' Block events (message boxes, etc)
objExcel.EnableEvents = False
' Find an loop through Excel files
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(DirectoryToSearch)
For Each File In Folder.Files
Set wb = objExcel.Workbooks.Open(File)
UpdateExternalLinks Workbook:=wb, LinkToUpdate:=LinkToUpdate, NewLink:=NewLink
wb.Close
Next File
Set wb = Nothing
Set objExcel = Nothing
Set File = Nothing
Set Folder = Nothing
Set FSO = Nothing
End Sub
You can call this code like this:
Sub DoUpdate()
UpdateExternalLinksInDirectory DirectoryToSearch:="C:\Users\User\Random\FakeFolder", LinkToUpdate:="C:\Users\User\Random\FakeData.xlsx"
End Sub
As is, this code will loop through each Excel (.xlsx) file in "C:\Users\User\Random\FakeFolder", find any links pointing at "C:\Users\User\Random\FakeData.xlsx", change them to point at the Excel file itself (i.e. remove the external links), and save the workbook.
Hope it works out!
Upvotes: 1