Format changing when file is copied

D

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,375
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have a button on my spreadsheet that makes a copy of the spreadsheet, here is a screenshot https://www.screencast.com/t/kzrb83Vrar. When I try and make a new document it copies the spreadsheet but the 6 boxes from the Add 10% box get squashed up and I have no idea why. Here is a screenshot of what the file looks like when the new document is made https://www.screencast.com/t/IdCYyLBlVVAT.

The code behind the button that makes the new document is:

Code: 
Dim newDoc As String
    newDoc = "NPSS work allocation sheet " & Year(Now) + 1 & ".xlsm"

    
  
    ActiveWorkbook.SaveCopyAs Filename:=newDoc
    
    Workbooks.Open Filename:=newDoc
    
    With Sheets("home")
        .Range("B20") = "July " & Year(Now)
        .Range("B21") = "August " & Year(Now)
        .Range("B22") = "September " & Year(Now)
        .Range("B23") = "October " & Year(Now)
        .Range("B24") = "November " & Year(Now)
        .Range("B25") = "December " & Year(Now)
        .Range("E20") = "January " & Year(Now) + 1
        .Range("E21") = "February " & Year(Now) + 1
        .Range("E22") = "March " & Year(Now) + 1
        .Range("E23") = "April " & Year(Now) + 1
        .Range("E24") = "May " & Year(Now) + 1
        .Range("E25") = "June " & Year(Now) + 1
    End With
        
        
   
    
    With Workbooks(newDoc)
        .Sheets("July " & Range("E18")).Name = "July " & Year(Now)
            With Sheets("July " & Year(Now))
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "July " & Year(Now) + 1
            End With
            
        .Sheets("August " & Range("E18")).Name = "August " & Year(Now)
            With Sheets("August " & Year(Now))
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "August " & Year(Now)
            End With
            
        .Sheets("September " & Range("E18")).Name = "September " & Year(Now)
            With Sheets("September " & Year(Now))
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "September " & Year(Now) + 1
            End With
            
        .Sheets("October " & Range("E18")).Name = "October " & Year(Now)
            With Sheets("October " & Year(Now))
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "October " & Year(Now) + 1
            End With
            
        .Sheets("November " & Range("E18")).Name = "November " & Year(Now)
            With Sheets("November " & Year(Now))
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "November " & Year(Now) + 1
            End With
            
        .Sheets("December " & Range("E18")).Name = "December " & Year(Now)
            With Sheets("December " & Year(Now))
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "December " & Year(Now) + 1
            End With
             
        .Sheets("January " & Range("E18") + 1).Name = "January " & Year(Now) + 1
            With Sheets("January " & Year(Now) + 1)
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "January " & Year(Now) + 2
            End With
               
        .Sheets("February " & Range("E18") + 1).Name = "February " & Year(Now) + 1
            With Sheets("February " & Year(Now) + 1)
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "February " & Year(Now) + 2
            End With
            
        .Sheets("March " & Range("E18") + 1).Name = "March " & Year(Now) + 1
            With Sheets("March " & Year(Now) + 1)
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "March " & Year(Now) + 2
            End With
                    
        .Sheets("April " & Range("E18") + 1).Name = "April " & Year(Now) + 1
            With Sheets("April " & Year(Now) + 1)
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "April " & Year(Now) + 2
            End With
     
        .Sheets("May " & Range("E18") + 1).Name = "May " & Year(Now) + 1
            With Sheets("May " & Year(Now) + 1)
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "May " & Year(Now) + 2
            End With
            
        .Sheets("June " & Range("E18") + 1).Name = "June " & Year(Now) + 1
            With Sheets("June " & Year(Now) + 1)
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & "June " & Year(Now) + 2
            End With
            
        .Sheets("All Costings").Range("A4:E2000").Clear
                    
    End With
    
       
    
End Sub

 
Sort by date Sort by votes

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
If you change this

Code: 
ActiveWorkbook.SaveCopyAs Filename:=newDoc

to this
Code: 
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & newDoc

You also must change this

Code: 
Workbooks.Open Filename:=newDoc

to this

Code: 
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & newDoc
 
Upvote 0
Some other random comments from test driving your workbook:

The boxes do not squash when I copy your file, but I do notice that some of your shapes are undersized for the text they contain. Also at least one instance of white font on white background in one of the boxes is obscuring your caption text.

The code called by the user buttons is a bit brittle. What I mean by that is that if anything goes wrong, the code crashes. Example: If I type in a new worksheet name and press the 'Add new worksheet' button everything works, but if I press the button a second time, the code crashes with a runtime error (because a new sheet with that name has already been created). No big deal if this workbook is only for you, but it seems like something you are creating for others to use. So pressing the button twice would be an incredibly common thing for a user to do, and the code should anticipate it, display a message box, then exit gracefully.

You have 16 code modules. Consider consolidating all code modules into one.

Add "option explicit" to the top of the remaining standard code module and to each worksheet code module containing code, which will force you to explicitly declare each variable. Right now you have a mish-mash of declared and undeclared variables which makes your code both error-prone and hard to debug.

Your inconsistent use of protection is causing trouble and is responsible for some of the runtime errors I saw. Example: your macro to create a new workbook unprotects "home" then saves a copy, then reopens the copy and tries to modify things - but the in the copy, "home" is still password protected (because of code elsewhere) so a runtime error occurs. Recommend you remove all sheet protection everywhere in your code and get your macros working reliably first. Then add the code to protect things back in, testing as you go.
 
Upvote 0
Thanks for that help with my code. I am only learning to code, so it is not very streamlined yet. I will get back to you if I have some problems in trying to implement the code.
 
Upvote 0
What code do I need to add in so that it creates a check that exits the code if the sheet exists?
 
Upvote 0
dpaton05 said:
What code do I need to add in so that it creates a check that exits the code if the sheet exists?
Click to expand...

If I wanted the code to exit if Sheet3 exists, something like this.

Code: 
    Dim WS As Worksheet
 
    For Each WS In ThisWorkbook.Worksheets
   	If WS.Name = "Sheet3" then
	  exit sub
	end if
    Next WS
 
Upvote 0
FWIW,

Code: 
Private Sub cmdNewTool_Click()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim newDoc As String, PrevYear As String, ThisYear As String, NextYear As String, SavedPath As String
    Dim Month As Variant, Months As Variant

    Set WB = ThisWorkbook

    newDoc = "NPSS work allocation sheet " & Year(Now) + 1 & ".xlsm"
    SavedPath = ThisWorkbook.Path & "\" & newDoc

    For Each WB In Application.Workbooks
        If WB.Name = newDoc Then
            MsgBox "Please close " & vbCr & vbCr & WB.Name & vbCr & vbCr _
                 & "before running this macro", vbExclamation, "Warning"
            Exit Sub
        End If
    Next WB

    ThisWorkbook.SaveCopyAs SavedPath

    Set WB = Workbooks.Open(Filename:=SavedPath)

    With WB.Worksheets("Home")
        .Unprotect Password:="costings"
        .Range("B20") = "July " & Year(Now)
        .Range("B21") = "August " & Year(Now)
        .Range("B22") = "September " & Year(Now)
        .Range("B23") = "October " & Year(Now)
        .Range("B24") = "November " & Year(Now)
        .Range("B25") = "December " & Year(Now)
        .Range("E20") = "January " & Year(Now) + 1
        .Range("E21") = "February " & Year(Now) + 1
        .Range("E22") = "March " & Year(Now) + 1
        .Range("E23") = "April " & Year(Now) + 1
        .Range("E24") = "May " & Year(Now) + 1
        .Range("E25") = "June " & Year(Now) + 1
    End With

    Months = Array("July ", "August ", "September ", "October ", "November ", "December ", "January ", "February ", "March ", "April ", "May ", "June ")

    For Each Month In Months
        Select Case Month
        Case "July ", "August ", "September ", "October ", "November ", "December "
            PrevYear = ThisWorkbook.Worksheets("Home").Range("E18").Value
            ThisYear = Year(Now)
            NextYear = Year(Now) + 1
        Case "January ", "February ", "March ", "April ", "May ", "June "
            PrevYear = ThisWorkbook.Worksheets("Home").Range("E18").Value + 1
            ThisYear = Year(Now) + 1
            NextYear = Year(Now) + 2
        End Select

        With WB
            Set WS = .Worksheets(Month & PrevYear)
            With WS
                .Name = Month & ThisYear
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & Month & NextYear
            End With
        End With

    Next Month
    WB.Worksheets("All Costings").Range("A4:E2000").Clear
    WB.Protect Password:="costings"
    WB.Activate
End Sub
 
Upvote 0
I tried that code but it said it can't do anything as it says the sheet is protected. I tried putting the following code at the beginning of the procedure, after WB is set as this workbook.


Code: 
WB.Unprotect Password:="costings"

This is my code:

Code: 
Private Sub cmdNewTool_Click()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim newDoc As String, PrevYear As String, ThisYear As String, NextYear As String, SavedPath As String
    Dim Month As Variant, Months As Variant

    Set WB = ThisWorkbook
        WB.Unprotect Password:="costings"
    newDoc = "NPSS work allocation sheet " & Year(Now) + 1 & ".xlsm"
    SavedPath = ThisWorkbook.Path & "\" & newDoc

    For Each WB In Application.Workbooks
        If WB.Name = newDoc Then
            MsgBox "Please close " & vbCr & vbCr & WB.Name & vbCr & vbCr _
                 & "before running this macro", vbExclamation, "Warning"
            Exit Sub
        End If
    Next WB

    ThisWorkbook.SaveCopyAs SavedPath

    Set WB = Workbooks.Open(Filename:=SavedPath)

    With WB.Worksheets("Home")
        .Unprotect Password:="costings"
        .Range("B20") = "July " & Year(Now)
        .Range("B21") = "August " & Year(Now)
        .Range("B22") = "September " & Year(Now)
        .Range("B23") = "October " & Year(Now)
        .Range("B24") = "November " & Year(Now)
        .Range("B25") = "December " & Year(Now)
        .Range("E20") = "January " & Year(Now) + 1
        .Range("E21") = "February " & Year(Now) + 1
        .Range("E22") = "March " & Year(Now) + 1
        .Range("E23") = "April " & Year(Now) + 1
        .Range("E24") = "May " & Year(Now) + 1
        .Range("E25") = "June " & Year(Now) + 1
    End With

    Months = Array("July ", "August ", "September ", "October ", "November ", "December ", "January ", "February ", "March ", "April ", "May ", "June ")

    For Each Month In Months
        Select Case Month
        Case "July ", "August ", "September ", "October ", "November ", "December "
            PrevYear = ThisWorkbook.Worksheets("Home").Range("E18").Value
            ThisYear = Year(Now)
            NextYear = Year(Now) + 1
        Case "January ", "February ", "March ", "April ", "May ", "June "
            PrevYear = ThisWorkbook.Worksheets("Home").Range("E18").Value + 1
            ThisYear = Year(Now) + 1
            NextYear = Year(Now) + 2
        End Select

        With WB
            Set WS = .Worksheets(Month & PrevYear)
            With WS
                .Name = Month & ThisYear
                .Range("A4:E2000").Clear
                .Range("A1").Value = "501 NPSS " & Month & NextYear
            End With
        End With

    Next Month
    WB.Worksheets("All Costings").Range("A4:E2000").Clear
    
    WB.Activate
End Sub


Despite the unprotect code I entered at the start, it says it is still protected??
 
Upvote 0
dpaton05 said:
Despite the unprotect code I entered at the start, it says it is still protected??
Click to expand...

That's not too surprising since "costings" is a worksheet password, but the code you have added is trying to unprotect WB, a workbook object. Try

Code: 
ThisWorkbook.Worksheets("Home").Unprotect Password:="costings"

instead. That's why I said earlier that I've found it to be best to remove or comment out all code that protects or unprotects worksheets until I have gotten my macro functionality sorted out. Only after I'm happy that the macros work, do I go back and add code to protect worksheets.
 
Upvote 0
rlv01 said:
That's not too surprising since "costings" is a worksheet password, but the code you have added is trying to unprotect WB, a workbook object. Try

Code: 
ThisWorkbook.Worksheets("Home").Unprotect Password:="costings"

instead. That's why I said earlier that I've found it to be best to remove or comment out all code that protects or unprotects worksheets until I have gotten my macro functionality sorted out. Only after I'm happy that the macros work, do I go back and add code to protect worksheets.
Click to expand...


Thanks, that worked perfectly :) thanks, I found a sheet that still had a password on it so that's why it wasn't working.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Using index and match from another source excel file
2
Replies
10
Views
666
Peter_SSs
Peter_SSs
M
  • Question Question
Calc cumulative by month
Replies
6
Views
201
mylamly26
M
M
  • Solved
Nested Xlookup not returning all data
Replies
2
Views
442
Mat1968
M
D
  • Solved
Clear contents rows macro
Replies
7
Views
80
Peter_SSs
Peter_SSs
S
  • Question Question
Employee Training Tracker
Replies
0
Views
233
Schuyla
S

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top