VBA Batch Update external links

[JasonExcel]

I have an Excel file that is looking at a few hundred external Excel files. These external links now need to be changed to new files each of which has a new file path and name. I have a list of all the old files paths and names in column A of a spreadsheet and a list of all the new files paths and names in column B of the same sheet. Is there a way to loop through the spreadsheet and replace all the old external links per column A with their equivalents from the same row in column B.

[TABLE="width: 500"]
<tbody>[TR]
[TD][TABLE="width: 177"]
<tbody>[TR]
[TD="width: 177"]S:\OldPath\OldName1.xlsx[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]S:\NewPath\NewName1.xlsx[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 177"]
<tbody>[TR]
[TD="width: 177"]S:\OldPath\OldName2.xlsx[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]S:\NewPath\NewName2.xlsx[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]S:\OldPath\OldName3.xlsx[/TD]
[TD]S:\NewPath\NewName3.xlsx[/TD]
[/TR]
</tbody>[/TABLE]

 

[Domenic]

The following macro assumes that the active sheet contains the data, and it also assumes that the new link is a valid one...

Option Explicit

Sub ChangeLinks()

    Dim currentLink As Variant
    Dim newLink As Variant
    Dim lookupRange As Range
    Dim lastRow As Long
    Dim i As Long
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set lookupRange = Range("A1:B" & lastRow)

    For Each currentLink In ActiveWorkbook.LinkSources(Type:=xlExcelLinks)
        newLink = Application.VLookup(currentLink, lookupRange, 2, 0)
        If Not IsError(newLink) Then
            ActiveWorkbook.ChangeLink _
                Name:=currentLink, _
                NewName:=newLink, _
                Type:=xlLinkTypeExcelLinks
        End If
    Next currentLink
    
End Sub

Hope this helps!

 

[JasonExcel]

The following macro assumes that the active sheet contains the data, and it also assumes that the new link is a valid one...

Option Explicit

Sub ChangeLinks()

    Dim currentLink As Variant
    Dim newLink As Variant
    Dim lookupRange As Range
    Dim lastRow As Long
    Dim i As Long
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set lookupRange = Range("A1:B" & lastRow)

    For Each currentLink In ActiveWorkbook.LinkSources(Type:=xlExcelLinks)
        newLink = Application.VLookup(currentLink, lookupRange, 2, 0)
        If Not IsError(newLink) Then
            ActiveWorkbook.ChangeLink _
                Name:=currentLink, _
                NewName:=newLink, _
                Type:=xlLinkTypeExcelLinks
        End If
    Next currentLink
    
End Sub

Hope this helps!

Thank you Domenic! This solution worked perfectly, I didn't even adjust a single line of code. You have saved me an enormous amount of monotony and repetition. Thank you very very much!