Rob Henson
asked on
Copy a sheet and Break Links
I have a consolidation file which shows a summary of 70+ Project Files.
In this file we have a "Current" sheet which has Live Links to the source files and historical sheets for prior periods with hard coded values.
I am trying to automate the creation of these periodic sheets. The obvious way to do this would be to copy the sheet, select all and copy paste values. However this overwrites any summation within the sheet as well as the File Links which I don't want to do.
The way I thought of getting round this was to copy the sheet to a new workbook, break the links and then copy back to the original file. In addition I need to check that the sheet name that the user chooses doesn't already exist and need the option to let the user bail out by clicking Cancel.
I have come up with the following script to do this but it isn't working.
1) Entering a name that already exists gives the error message but entering a new name just goes into a loop and clicking Cancel doesn't do anything.
2) If I comment out all the sheet name checks and let it get through to the BreakLinks section I get an error message and the "arrLinks(I)" variable shows as blank. Is this because I haven't saved the new workbook?? I don't need to save it as it is only a temporary holding file. If it needs to be saved then its OK for it to go in the same directory as the source file but I will need an extra section for getting rid of the saved file so it doesn't cause issues at a later date. I adapted this section from some code that RGonzo supplied for changing multiple links so I might have done it incorrectly.
Many thanks
Rob H
In this file we have a "Current" sheet which has Live Links to the source files and historical sheets for prior periods with hard coded values.
I am trying to automate the creation of these periodic sheets. The obvious way to do this would be to copy the sheet, select all and copy paste values. However this overwrites any summation within the sheet as well as the File Links which I don't want to do.
The way I thought of getting round this was to copy the sheet to a new workbook, break the links and then copy back to the original file. In addition I need to check that the sheet name that the user chooses doesn't already exist and need the option to let the user bail out by clicking Cancel.
I have come up with the following script to do this but it isn't working.
1) Entering a name that already exists gives the error message but entering a new name just goes into a loop and clicking Cancel doesn't do anything.
2) If I comment out all the sheet name checks and let it get through to the BreakLinks section I get an error message and the "arrLinks(I)" variable shows as blank. Is this because I haven't saved the new workbook?? I don't need to save it as it is only a temporary holding file. If it needs to be saved then its OK for it to go in the same directory as the source file but I will need an extra section for getting rid of the saved file so it doesn't cause issues at a later date. I adapted this section from some code that RGonzo supplied for changing multiple links so I might have done it incorrectly.
Sub CreateCopy()
SourceFile = ActiveWorkbook.Name
Sheets("Current").Select
ShtCount = ActiveWorkbook.Sheets.Count
Do
NewPeriod = InputBox("Enter period number for copied sheet.", "Period Number", "AP#")
If NewPeriod = vbCancel Then Exit Sub
For Each Sht In ActiveWorkbook.Sheets
If Sht.Name = NewPeriod Then
NameExists = True
ErrMsg = MsgBox("That sheet exists! Choose a new name.")
If ErrMsg = vbCancel Then Exit Sub
End If
Next Sht
Loop Until NameExists = False
Sheets("Current").Copy
Sheets("Current").Name = NewPeriod
NewFile = ActiveWorkbook.Name
For I = 1 To UBound(arrLinks)
MyLink = arrLinks(I)
Application.DisplayAlerts = False
ActiveWorkbook.BreakLink Name:=MyLink, Type:=xlExcelLinks
Application.DisplayAlerts = True
Next
Sheets(NewPeriod).Select
Sheets(NewPeriod).Move Before:=Workbooks(SourceFile).Sheets(ShtCount)
Windows(NewFile).Activate
ActiveWindow.Close SaveChanges:=False
End Sub
Any suggestions greatly appreciated on how to correct or an alternative method for achieving this.Many thanks
Rob H
Hi,
pls try
pls try
Sub CreateCopy()
SourceFile = ActiveWorkbook.Name
Sheets("Current").Select
ShtCount = ActiveWorkbook.Sheets.Count
Do
NewPeriod = InputBox("Enter period number for copied sheet.", "Period Number", "AP#")
If NewPeriod = vbCancel Then Exit Sub
NameExists = Evaluate("=ISREF('" & NewPeriod & "'!A1)")
If NameExists Then
ErrMsg = MsgBox("That sheet exists! Choose a new name.", vbOKCancel)
If ErrMsg = vbCancel Then Exit Sub
End If
Loop Until NameExists = False
Sheets("Current").Copy
Sheets("Current").Name = NewPeriod
NewFile = ActiveWorkbook.Name
arrLinks = Workbooks(NewFile).LinkSources(xlExcelLinks)
For I = 1 To UBound(arrLinks)
MyLink = arrLinks(I)
Application.DisplayAlerts = False
ActiveWorkbook.BreakLink Name:=MyLink, Type:=xlExcelLinks
Application.DisplayAlerts = True
Next
Sheets(NewPeriod).Select
Sheets(NewPeriod).Move Before:=Workbooks(SourceFile).Sheets(ShtCount)
Windows(NewFile).Activate
ActiveWindow.Close SaveChanges:=False
End Sub
Regards
Could you send a dummy?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Can't send a dummy because I would have to break the links and it has lots of confidential work in it.
Line 18 is working to change the name of the sheet in the new file
Line 32 and 33 just close the temporary file without closing, its not getting that far when it errors out.
I have been trying to fix it and I now have:
The vbCancel option at this point now works though and I can exit the Sub but the same line on the initial entry InputBox doesn't work; if I click Cancel on this Input it goes on and errors out because NewPeriod is blank.
Thanks
Rob H
Line 18 is working to change the name of the sheet in the new file
Line 32 and 33 just close the temporary file without closing, its not getting that far when it errors out.
I have been trying to fix it and I now have:
Do
NewPeriod = InputBox("Enter period number for copied sheet.", "Period Number", "AP#")
If NewPeriod = vbCancel Then Exit Sub
For Each Worksheet In ActiveWorkbook.Worksheets
If Worksheet.Name = NewPeriod Then
NameExists = "True"
ErrMsg = MsgBox("That sheet exists! Choose a new name.", vbOKCancel, "Error")
If ErrMsg = vbCancel Then
Exit Sub
Else
End If
Else
NameExists = "False"
End If
Next Worksheet
Loop Until NameExists = "False"
When I enter a name that exists I get the error message from line 7 of above but it still goes on and copies the sheet to a new workbook and renames it. The vbCancel option at this point now works though and I can exit the Sub but the same line on the initial entry InputBox doesn't work; if I click Cancel on this Input it goes on and errors out because NewPeriod is blank.
Thanks
Rob H
Replace with
If NewPeriod = "" Then Exit Sub
Rob, I see part of the problem being that even if the user enters a new sheet name inside the for each loop, you're not reiterating through that loop to check the new name against all sheets:
For Each Sht In ActiveWorkbook.Sheets
If Sht.Name = NewPeriod Then
NameExists = True
ErrMsg = MsgBox("That sheet exists! Choose a new name.")
If ErrMsg = vbCancel Then Exit Sub
End If
Next Sht
You might set this up as a separate function to return true or false to be called for the initial check and for any subsequent sht name checks.
the use of
saves you a to do a loop
NameExists = Evaluate("=ISREF('" & NewPeriod & "'!A1)")
saves you a to do a loop
ASKER
Apologies, looks like my screen didn't refresh fully and I have missed a few posts!!
Got the entering a valid name bit sorted with:
As always, your help is much appreciated.
Thanks
Rob H
Got the entering a valid name bit sorted with:
Do
NewPeriod = InputBox("Enter period number for copied sheet.", "Period Number", "AP#")
If NewPeriod = "" Then Exit Sub
NameExists = Evaluate("=ISREF('" & NewPeriod & "'!A1)")
If NameExists Then
ErrMsg = MsgBox("That sheet exists! Choose a new name.", vbOKCancel)
If ErrMsg = vbCancel Then Exit Sub
End If
Loop Until NameExists = False
A new sheet is created and the name changes to that entered. However, the BreakLinks section is still not working.As always, your help is much appreciated.
Thanks
Rob H
Have you added
arrLinks = Workbooks(NewFile).LinkSou rces(xlExc elLinks)
arrLinks = Workbooks(NewFile).LinkSou
ASKER
Nope, missed that. Trying it now.
ASKER
Ta dah!! It now all works. I got an error at the end when trying to reselect the NewFile but that was because it was no longer there so as you said earlier, last two lines not needed.
Many thanks!!
Many thanks!!
ASKER
Dim Sht as ???