Solved

Copy a sheet and Break Links

Posted on 2016-07-15
12
40 Views
Last Modified: 2016-07-15
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.

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

Open in new window

Any suggestions greatly appreciated on how to correct or an alternative method for achieving this.

Many thanks
Rob H
0
Comment
Question by:Rob Henson
  • 6
  • 5
12 Comments
 
LVL 32

Author Comment

by:Rob Henson
ID: 41712638
Sht.Name is coming out blank - how do I define the Sht variable as a Worksheet so that I can get the name for it??

Dim Sht as ???
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41712644
Hi,

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

Open in new window

Regards
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41712645
Could you send a dummy?
0
 
LVL 49

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 41712651
Probably you have to to change line 18
  Activesheet.Name = NewPeriod

and delete line 32 and 33

EDITED code
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
    ActiveSheet.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

Open in new window

0
 
LVL 32

Author Comment

by:Rob Henson
ID: 41712663
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:
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"

Open in new window

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
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41712669
Replace with

If NewPeriod = "" Then Exit Sub

Open in new window

0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 7

Expert Comment

by:Doug
ID: 41712670
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

Open in new window

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.
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41712671
the use of
        NameExists = Evaluate("=ISREF('" & NewPeriod & "'!A1)")

Open in new window


saves you a to do a loop
0
 
LVL 32

Author Comment

by:Rob Henson
ID: 41712678
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:

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

Open in new window

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
0
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41712681
Have you added

arrLinks = Workbooks(NewFile).LinkSources(xlExcelLinks)
0
 
LVL 32

Author Comment

by:Rob Henson
ID: 41712708
Nope, missed that. Trying it now.
0
 
LVL 32

Author Closing Comment

by:Rob Henson
ID: 41712719
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!!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Hiding column macro 10 28
Excel Formula 4 28
Excel 2016 Not Responding Issues 6 27
selection of current record jumps to a non-selected record 8 35
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

919 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now