Macro to break one (or all) link just in some files opened (not in other ones)

[Massi_921]

Hi Everyone,
I'm Massimiliano and I'm writing you from Italy, so sorry for my English, I'm not so good
For my job I have to manage a lot of Excel files and I'm creating a macro to help me do my work faster about opening and savings
Here below You can find the code I wrote, I know it is a bit rudimental but I'm just starting out

I have to open File A and File B which are linked to a Pivot in File 1. I open both file. Than I save with name File A and file B in a new directory
At this point I would break all the links in File A and in File B. I tried to do this but it doesn't work (See below "ActiveWorkbook.BreakLink Name:="Percorso file\File 1.xlsx", Type:=xlExcelLinks")

Could you please help me? I found different solutions in the web but I've the feeling that those would break links in all opened files including File 1 (which doesn't have to be changed)
The real point is that during the Macro, File 1 - in my opinion - must be open, and action of "breaklinks" have to be implemented just in File A and File B
Thank you so much
Massimiliano

Sub OPEN FILE A, FILE B AND FILE 1. SAVE WITH NAME FILE A AND FILE B IN A NEW DIRECTORY. BREAK LINKS IN FILE A AND FILE B

' OPEN FILE 1
'Application.Workbooks.Open Filename:="Percorso file 1\File 1.xlsx", UpdateLinks:=False

' OPEN FILE A
Application.Workbooks.Open Filename:="Percorso file A\File A.xlsx", UpdateLinks:=False

' OPEN FILE B
Application.Workbooks.Open Filename:="Percorso file B\File B.xlsx", UpdateLinks:=False


' SAVE WITH NAME FILE A AND FILE B OVERWRITING IN THE NEW DIRECTORY + ATTEMPT TO BREAK LINKS

‘ SAVE WITH NAME FILE A
Workbooks("File A.xlsx").SaveCopyAs Filename:="Nuovo percorso file A\File A.xlsx"

‘ OVERWRITE FILE A IN THE NEW DIRECTORY
Application.DisplayAlerts = True

‘ BREAK LINKS IN FILE A
ActiveWorkbook.BreakLink Name:="Percorso file\File 1.xlsx", Type:=xlExcelLinks

‘ SAVE WITH NAME FILE B
Workbooks("File B.xlsx").SaveCopyAs Filename:="Nuovo percorso file B\File B.xlsx"

‘ OVERWRITE FILE A IN THE NEW DIRECTORY
Application.DisplayAlerts = True

‘ BREAK LINKS IN FILE A
ActiveWorkbook.BreakLink Name:="Percorso file\File 1.xlsx", Type:=xlExcelLinks


End Sub

 

[LazyBug]

Hello, Massimiliano!
I misunderstood your goal and don't got what workbook contain your code, but to delete hyperlinks in active worksheet, try this on a copy of your data:

Sub dhl()
Dim r As Range
   For Each r In ActiveSheet.UsedRange
       If r.Hyperlinks.Count = 1 Then r.Hyperlinks.Delete
   Next r
End Sub

 

[Massi_921]

Hello @LazyBug , thanks a lot for your answer!
I try to explain better my need. I create the macro in my personal macro folder. So then I open an empty Excel file and go to Visual Basic, in modules, and launch the macro to open all the files included in the Macro code and make what I need on them
I tried the code you've provided to me but it doesn't seem to work
The real issue is that now I've discovered that I need to delete just the link with File 1. I try to explain, even if if it is quite difficult
File A and File B are linked to a lot of file, among which also File 1. In file 1 I have a Pivot and File A and B are filled with value just if File 1 is open (if it is close, all values are equal to zero in File A and File B --> I've found the file already structured in this way, someone among my colleagues before created long time ago)

So I have to open conteporanouesly A, B and 1 and then I have to save with name A and B (becuase I need both files A and B with link with File 1 and files A and B without link with File 1). Then I need to interrupt just the link in File 1. But I don't know how to do this, also because launghing my Macro I have open File A, B and 1 and I need to do this action of "breaklinks" just in File A and B
I know it is a bit confusing I don't blame you if you are not able to understand this chaos
Many thanks

 

[LazyBug]

I hope i understand you the right way. In any case i'd recommend to copy all your data files and test on it firstly.
A couple of questions.
1) Do you have any updated (changing) data in the Pivot Table in the File1?
2) How many links do you have between File1 and FilesA, FilesB?
3) How many sheets there are in File1? Which of them contains links to another files?

 

[Massi_921]

Hi @LazyBug
1) The pivot table in the File1 is linked to a sheet named "source" included in the same File 1 (colleagues take data from a query from our ERP [SAP] and copy the data month by month in the sheet "source" of File 1) so then they click on "Update All". They have created different pivot tables in order to see costs in one Pivot, sales in another one and so on
2) I have several links, one for every month but also for every kind of item. In File A - for example - in January I have the item "Material Expenses" and I have to bring this data from the Pivot "Costs" in the File 1 and to do this I use a VLOOKUP
3) File 1 has about 20 sheets, but it is not linked to other files. The source of every Pivot table is the sheet "source" where colleagues copy data from our ERP

Please Note: when I go on File A and B to break the link manually, It is enough to go in Data --> Change Links --> Select the link I want to break (Name of File1) --> Click on break links -> Done
I tried to create a Macro doing this action and I copied it in VBA but it didn't work
For me it is enough to break in general the link with File 1 while it is open, I don't need to break just some links. All links with the Pivots of File 1
I know it is quite complicate, thanks a lot for your response

 

[LazyBug]

Hello, @Massi_921!
Sorry for my boring, some more questions, to summarize. Correct me if i miss your goals in any point or mistaken.
By macro you want:
1. To open fileA, fileB and file1 contemporaneously. (If It's right, do they have the same location?)
(2. To update data in the fileA and fileB based on the file1 table. - it happens itself by formulas)
3. To break links of the fileA and fileB, and then save them in another location with the same names (fileA and fileB). File1 left without any changes.
4. To close (all? some?) these files.

 

[Massi_921]

Hi @LazyBug , dont't worry! You are doing me a favour
1. Right, but they don't have the same location
2. Yes. The updating of File A and file B happens automatically when I open it
3. Exactly
4. To close all of them but it is enough also to close just File A and File B
Many thanks for the time you are dedicating to my question, you are so kind!

 

[LazyBug]

Hello, @Massi_921! Amend files paths and files names to see if it does what you want. Then try this on a copy of your files. I tried to add comments to the VBA code, so you can see its work step by step, and i hope, it helps to understand it.
This option'll kill all formulas in FileA and FileB copies, replacing them by values:

Sub Massi_2()

Dim NewPath As String
Dim wb As Workbook, sh As Worksheet, r As Range, c As Range

    Application.ScreenUpdating = False
    'open File1 without links update
    Application.Workbooks.Open "J:\TEST\File1.xls", 0
    'then open FileA & FileB with links updating
    Application.Workbooks.Open "J:\TEST\OLDPATH\FileB.xls", 1
    Application.Workbooks.Open "J:\TEST\OLDPATH\FileA.xls", 1
        For Each wb In Workbooks
            'check every open workbook name. if it is FileA or FileB, then
            If wb.Name = "FileA.xls" Or wb.Name = "FileB.xls" Then
                'on every sheet
                For Each sh In wb.Worksheets
                    On Error Resume Next
                    Set r = Nothing
                    'check every cell in active data range if it has formula
                    Set r = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
                    On Error GoTo 0
                    If Not r Is Nothing Then
                        For Each c In r
                            'replace by value
                            c.Formula = c.Value
                        Next c
                    End If
                Next sh
        
                NewPath = "J:\TEST\NEWPATH\"
                'save copy of file with same name in another place
                wb.SaveCopyAs (NewPath & wb.Name)
                'close original file wo saving
                wb.Close 0
            End If
        Next wb
    'close File1 without saving changes
    Workbooks("File1.xls").Close 0
    Application.ScreenUpdating = True
End Sub

 

[LazyBug]

And this one kills only formulas, contained definite string (here: File1) in FileA and FileB copies:

Sub Massi_3()

Dim NewPath As String
Dim wb As Workbook, sh As Worksheet, r As Range, c As Range

    Application.ScreenUpdating = False
    'open File1 without links update
    Application.Workbooks.Open "J:\TEST\File1.xls", 0
    'then open FileA & FileB with links updating
    Application.Workbooks.Open "J:\TEST\OLDPATH\FileB.xls", 1
    Application.Workbooks.Open "J:\TEST\OLDPATH\FileA.xls", 1
        For Each wb In Workbooks
            'check every open workbook name. if it is FileA or FileB, then
            If wb.Name = "FileA.xls" Or wb.Name = "FileB.xls" Then
                For Each sh In wb.Worksheets
                    On Error Resume Next
                    Dim str As String, fres As String
                   
                        str = "File1"   'part of formula or link containing string to find
                       
                    Set r = Nothing
                    'check every cell in active data range if it has formulas
                    Set r = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
                        'finds requied string at these cells and their parts
                        Set c = r.Find(str, LookIn:=xlFormulas, LookAt:=xlPart) 'i think LookIn option here is excess, but i didnt check it
                            If Not c Is Nothing Then
                                fres = c.Address
                                Do
                                'replace formulas by values
                                c.Value = c.Value
                                    Set c = r.Find(str, after:=c, LookIn:=xlFormulas, LookAt:=xlPart)
                            If c Is Nothing Then Exit Do
                        Loop While c.Address <> fres
                    End If
                Next sh
       
                NewPath = "J:\TEST\NEWPATH\"
                'save copy of file with same name in another place
                wb.SaveCopyAs (NewPath & wb.Name)
                'close original file wo saving
                wb.Close 0
            End If
        Next wb
    'close File1 without saving changes
    Workbooks("File1.xls").Close 0
    Application.ScreenUpdating = True

End Sub

 

[Massi_921]

Hi @LazyBug! I don’t know how to thank you for all the time and the patient demonstrated. You are so kind!
Thanks a lot also for having added comment because I am learning VBA and it will be very useful for me to understand what the code is going to do
Tomorrow I’m going to try it step by step on a copy of the files, I’ll keep you updated about the result
Thanks thanks thanks