Format changing when file is copied

[dpaton05]

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:

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

 

[dpaton05]

CAn you upload to Dropbox ??
I'll take a look over the weekend

Sorry it took a while to get you this, I only just saw your message. Here is the link https://www.dropbox.com/s/cvx0lq26obliau4/Garrett's costing tool v3.2.xlsm?dl=0

Thankyou Michael

 

[rlv01]

If you change this

ActiveWorkbook.SaveCopyAs Filename:=newDoc

to this

ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & newDoc

You also must change this

Workbooks.Open Filename:=newDoc

to this

Workbooks.Open Filename:=ThisWorkbook.Path & "\" & newDoc

 

[rlv01]

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.

 

[dpaton05]

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.

 

[dpaton05]

What code do I need to add in so that it creates a check that exits the code if the sheet exists?

 

[rlv01]

What code do I need to add in so that it creates a check that exits the code if the sheet exists?

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

    Dim WS As Worksheet
 
    For Each WS In ThisWorkbook.Worksheets
   	If WS.Name = "Sheet3" then
	  exit sub
	end if
    Next WS

 

[rlv01]

FWIW,

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

 

[dpaton05]

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.

WB.Unprotect Password:="costings"

This is my 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??

 

[rlv01]

Despite the unprotect code I entered at the start, it says it is still protected??

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

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.

 

[dpaton05]

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

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.

Thanks, that worked perfectly thanks, I found a sheet that still had a password on it so that's why it wasn't working.