Rob
Rob

Reputation: 1

Can you remove workbook references in formulas on a whole sheet in Excel using VBA?

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

Answers (1)

Edunne
Edunne

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

Related Questions