Updating Headers is screwing up my page orientation and scaling

Question

so I burned a whole day yesterday getting side tracked on a different process for toggling images on and off based on a cell value. The funny thing is it all started from me writing a wee bit of VBA to update the Header and Footer Information automatically prior to printing or saving.

Situation

I have 12 worksheets currently in the workbook. Sheet1(HEADER AND FOOTER) contains all the information to go into the various header/footer locations.

Sheets 2-7 are the pages that get printed as a group and have the header and footers on them.

Sheets 2-6 are portrait letter pages with multiple pages on each sheet (I cannot force 1 page wide on certain sheets due to their layout).

Sheet 7 is landscape letter page.

If I print /save as pdf prior to writing the code and changing each page separately everything worked nice, all paged printed in their respective page layouts/setups.

When I implemented the VBA code in the beforeprint or beforesave in ThisWorkbook things did not go well. Depending on which variation of the VBA code I tried, either sheet 7 would adopt the portrait orientation and scaling same as the other sheets OR all sheets would be landscape and have the scaling of sheet 7.

OBJECTIVE

Update sheets 2 through 7 with the appropriate header/footer information while maintaining their original assigned page settings. That way when I print, sheets 2-6 are all portrait and sheet 7 is landscape all on letter paper.

What I have tried

I recorded a macro to get the base structure. Originally it had all sheets in one area and modifying them. I figured that the pages were all being made the same because they were all selected at the same time, So instead of selecting all them at once, I thought I would try modifying one sheet at a time. This lead to only one worksheet being printed, so I had to add reselecting all the sheets as the last line of code. This is the VBA code I currently have:

Private Sub WorkbookBeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ws As Worksheet

    For Each ws In Worksheets
    If ws.Name <> "HEADER AND FOOTER" And InStr(1, Left(ws.Name, 5), "Table", vbTextCompare) = 0 Then
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .CenterHeader = Sheets(1).Range("B1").Value & Chr(10) & "Load Evaluation"
            .RightHeader = _
            "Calculated by: " & Sheets(1).Range("B3").Value & "  Date: " & Sheets(1).Range("B4").Value & Chr(10) & "Checked By:  " & Sheets(1).Range("B5").Value & "  Date: " & Sheets(1).Range("B6").Value
            .LeftFooter = "Project Number: " & Sheets(1).Range("B2").Value
            .CenterFooter = "Page &P/&N"
            .RightFooter = "Print Date:  " & Sheets(1).Range("B7").Value
        End With
    End If
    Next ws
    Sheets(Array("General", "Loads", "Capacity", "Analysis", "POSTING", "SUMMARY")).Select
    Sheets("General").Activate
 End Sub

I was thinking maybe there is something wrong with the way I implemented the For Each as that is not a form I am familiar with. I was originally thinking about using a For x = 2 to ws.count - UDF_worksheet_count_names_starting_with_tables to loop through the sheets. I thought I would check in here first to see if there is a better approach to this problem.

ws is your For Each control variable but you don't use inside the If block. You act on ActiveSheet regardless of where the loop is. I would think that your problem would be that only one sheet is getting updated and not that too many are. What happens when you change With ActiveSheet.PageSetup to With ws.PageSetup? — Dick Kusleika
I see what you are getting at...I will try it out. At one point just below for each, I had ws.select....but I was only getting one worksheet to print at the time. However I may have removed that before I built the selection at the end. I will get back with the results as soon as I have them. — Forward Ed
ok I see what happened...I removed the _ in the subroutine name so it was not executing the code on save. I have now added that back in, and despite making the change from activesheet.pagesetup to ws.pagesetup, my worksheet(7) is being reformatted to portrait and scale of sheets 2-5. I suspect all pages are being formatted the same. its just that 2-5 need to be the same so I do not notice the change on them — Forward Ed

Forward Ed Forward Ed · Accepted Answer · 2015-10-28T20:16:07

So first off thanks to D.K. for the suggestion to change from activesheet.page setup to ws.pagesetup. This however did not solve the problem but did make a lot more sense. I then stumbled onto this thread: Excel headers/footers won't change via VBA unless blank. I was wondering what the line

 Application.PrintCommunication = False

actually did. When I commented that line out the last sheet's layout no longer got updated/changed to match the other pages and things are working as intended.

This is what the final code looks like:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ws As Worksheet

    For Each ws In Worksheets
        If ws.Name <> "HEADER AND FOOTER" And InStr(1, Left(ws.Name, 5), "Table", vbTextCompare) = 0 Then
            With ws.PageSetup
                .CenterHeader = Sheets(1).Range("B1").Value & Chr(10) & "Load Evaluation"
                .RightHeader = _
                "Calculated by: " & Sheets(1).Range("B3").Value & "  Date: " & Sheets(1).Range("B4").Value & Chr(10) & "Checked By:  " & Sheets(1).Range("B5").Value & "  Date: " & Sheets(1).Range("B6").Value
                .LeftFooter = "Project Number: " & Sheets(1).Range("B2").Value
                .CenterFooter = "Page &P/&N"
                .RightFooter = "Print Date:  " & Sheets(1).Range("B7").Value
            End With
        End If
    Next ws
 End Sub

Updating Headers is screwing up my page orientation and scaling

Situation

OBJECTIVE

What I have tried

1 Answers