Macro to print worksheet specific named range in footer for that worksheet

[Ana_P]

Hello,

I'm still a beginner with VBA/macros but I've done my head in trying to work out the following two questions on my own so anyone's help would be greatly appreciated.

I have a workbook with a number of worksheets, many of which have a worksheet specific named range for a cell called "WS_Ref".

My first issue is that I need the worksheet specific "WS_Ref" to print on the footer of the worksheet that it's for. The way the code is at the moment prints the Active Worksheet's "WS_Ref" on all of the footers; however I want the footer of each worksheet to contain it's own "WS_Ref". I have tried using ws.Range however I get the following: "Runtime error '1004': Method 'Range' of object '_Worksheet' failed". The code I have is as follows (with the part I'm having issues with in red font):

[COLOR=#333333]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Private Sub Workbook_BeforePrint(Cancel As Boolean)
  
    'Add info to each sheets' header and footer
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Range("A6").Value = "Income & Tax Summary" Or ws.Range("A6").Value = "Individual Tax Summary" Or ws.Range("A6").Value = "Tax Reconciliation (Company)" Or ws.Range("A6").Value = "Tax Reconciliation (Trust, Partnership)" Or ws.Range("A6").Value = "Tax Reconciliation (Sole Trader)" Then
            ws.PageSetup.LeftHeader = ""
            ws.PageSetup.LeftFooter = ""
            ws.PageSetup.CenterFooter = "&""Calibri""&I&8Liability limited by a scheme approved under Professional Standards Legislation"
            ws.PageSetup.RightFooter = ""
        ElseIf ws.Range("A6").Value = "Workpaper Index" Or ws.Range("A6").Value = "Work In Office Checklist" Then
            ws.PageSetup.LeftHeader = ""
            ws.PageSetup.LeftFooter = ""
            ws.PageSetup.CenterFooter = ""
            ws.PageSetup.RightFooter = ""
        ElseIf ws.Range("A6").Value = "Queries" Or ws.Range("A6").Value = "Review Points" Or ws.Range("A6").Value = "Issues for Next Year" Then
            ws.PageSetup.LeftHeader = ""
            ws.PageSetup.LeftFooter = "&""Calibri""&8" & Range("B2").Value & "/" & "&F"
            ws.PageSetup.CenterFooter = "&""Calibri""&I&8Liability limited by a scheme approved under Professional Standards Legislation"
            ws.PageSetup.RightFooter = "&""Calibri""&8&A"
        ElseIf ws.Range("A6").Value = "Journal Entries" Or ws.Range("A6").Value = "Adjusting Journal" Then
            ws.PageSetup.LeftHeader = "&""Calibri""&B&14" & Range("B1").Value
            ws.PageSetup.LeftFooter = "&""Calibri""&8" & Range("B2").Value & "/" & "&F" & "/" & "&A"
            ws.PageSetup.CenterFooter = ""
            ws.PageSetup.RightFooter = "&""Calibri""&10&Page &P"
        Else
            ws.PageSetup.LeftHeader = "&""Calibri""&B&14" & Range("B1").Value
            ws.PageSetup.LeftFooter = "&""Calibri""&8" & Range("B2").Value & Chr(10) & "&F" & Chr(10) & "&A"
            ws.PageSetup.CenterFooter = "&""Calibri""&I&8Liability limited by a scheme approved under Professional Standards Legislation"
            ws.PageSetup.RightFooter = "&8Prepared by: " & Range("Prepared_By").Value & Chr(10) & _
                                        "Reviewed by: " & Range("Reviewed_By").Value & Chr(10) & _
                                        "Ref:   " & [COLOR=#FF0000]Range("WS_Ref").Value[/COLOR]
        End If
    Next ws
End Sub</code>[/COLOR]

My second issue with the above macro is that there are approx. 40 worksheets in the workbook so when choosing to print a worksheet it takes a while before the code runs and does all the above before printing the worksheet needed. Is there any way to fix/change this above code so there isn't this lag each time a worksheet needs to be printed?

If I've not made my issues clear enough please let me know.

If anyone has any suggestions, you'll save my day as I have searched the internet far and wide!

Thanks

 

[shknbk2]

First issue: You said that "many" of the sheets have the named range, but not all of them do. It looks like the error you get with ws.Range might be choking when it gets to the pages that don't have the named range. In that case, you don't have any fallback position or error handling. That can be fixed. What would you like the string to say if there is no named range for a particular sheet?

Second issue: The code above runds through each sheet's header/footer assignment before you print anything. How often are you printing the whole spreadsheet? if you want the BeforePrint to run only on the activesheet, then the code can be changed to run only for the activesheet rather than for all sheets every time ("For Each ws In ActiveWorkbook.Worksheets")

 

[Ana_P]

Thanks for your reply!

The pages that don't have the named range are covered by the other "if/else" statements. Therefore all the worksheets that the last "else" works through has the worksheet specific named range. However if it were the case that there is no named range for a particular sheet than it can just be left blank as a fallback position or error handling (which I'm not exactly sure how it would be done).

Each worksheet is printed separately (don't believe there will ever be a case of printing them all together at once) so I guess the code can be changed to run only for the Activesheet. How would this be done? Also, is there a way to do it before print-preview rather than just before print so that when the user previews before printing they know all that information is there to be printed?

Greatly appreciate your pointers/help!! Thanks!

 

[shknbk2]

This code works on the activesheet and should get around the 1004 error.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  
    'Add info to each sheets' header and footer
    Dim ws As Worksheet
    Set ws = ActiveSheet
    If ws.Range("A6").Value = "Income & Tax Summary" Or ws.Range("A6").Value = "Individual Tax Summary" Or ws.Range("A6").Value = "Tax Reconciliation (Company)" Or ws.Range("A6").Value = "Tax Reconciliation (Trust, Partnership)" Or ws.Range("A6").Value = "Tax Reconciliation (Sole Trader)" Then
        ws.PageSetup.LeftHeader = ""
        ws.PageSetup.LeftFooter = ""
        ws.PageSetup.CenterFooter = "&""Calibri""&I&8Liability limited by a scheme approved under Professional Standards Legislation"
        ws.PageSetup.RightFooter = ""
    ElseIf ws.Range("A6").Value = "Workpaper Index" Or ws.Range("A6").Value = "Work In Office Checklist" Then
        ws.PageSetup.LeftHeader = ""
        ws.PageSetup.LeftFooter = ""
        ws.PageSetup.CenterFooter = ""
        ws.PageSetup.RightFooter = ""
    ElseIf ws.Range("A6").Value = "Queries" Or ws.Range("A6").Value = "Review Points" Or ws.Range("A6").Value = "Issues for Next Year" Then
        ws.PageSetup.LeftHeader = ""
        ws.PageSetup.LeftFooter = "&""Calibri""&8" & ws.Range("B2").Value & "/" & "&F"
        ws.PageSetup.CenterFooter = "&""Calibri""&I&8Liability limited by a scheme approved under Professional Standards Legislation"
        ws.PageSetup.RightFooter = "&""Calibri""&8&A"
    ElseIf ws.Range("A6").Value = "Journal Entries" Or ws.Range("A6").Value = "Adjusting Journal" Then
        ws.PageSetup.LeftHeader = "&""Calibri""&B&14" & ws.Range("B1").Value
        ws.PageSetup.LeftFooter = "&""Calibri""&8" & ws.Range("B2").Value & "/" & "&F" & "/" & "&A"
        ws.PageSetup.CenterFooter = ""
        ws.PageSetup.RightFooter = "&""Calibri""&10&Page &P"
    Else
        Dim ref As String
        On Error Resume Next
        ref = ws.Range("WS_Ref").Value
        On Error GoTo 0
        ws.PageSetup.LeftHeader = "&""Calibri""&B&14" & ws.Range("B1").Value
        ws.PageSetup.LeftFooter = "&""Calibri""&8" & ws.Range("B2").Value & Chr(10) & "&F" & Chr(10) & "&A"
        ws.PageSetup.CenterFooter = "&""Calibri""&I&8Liability limited by a scheme approved under Professional Standards Legislation"
        ws.PageSetup.RightFooter = "&8Prepared by: " & ws.Range("Prepared_By").Value & Chr(10) & _
                                    "Reviewed by: " & ws.Range("Reviewed_By").Value & Chr(10) & _
                                    "Ref:   " & ref
    End If
End Sub

The BeforePrint code apparently doesn't run before showing the print preview. Options to change the header before the print preview would be to manually run the code or to have another automatic workbook/worksheet code run, For example, if you save the file every time before printing you could use this in the BeforeSave event.

 

[Ana_P]

I will test the code in the morning and will get back to you if I encounter any further issues with the 1004 error.

The idea behind the macro I created is that all the worksheets in the workbook are updated with the respective header/footer (so when print-previewing all the information is there). If I read correctly, your re-writing of the code would only do the Activesheet, therefore each sheet would need to be printed at some point in order to have the correct header/footer?

However, your suggestion of the BeforeSave event - could I use my initial code (well at least the idea behind it) so when the file is saved it updates ALL the worksheets (not just the activesheet)? Does the BeforeSave event run even when autosave happens or just when you manually save the file? Wouldn't want to create a lag while the file is being used as that would probably be more frustrating then the BeforePrint lag!

Then I could use the BeforePrint event just for the activesheet in case any changes were made to the "WS_Ref" so they are correct upon printing.

Sorry for being a pain and running my thought processes by you - please correct me if I'm wrong! I'm self-taught VBA (used Google to try accomplish whatever task I thought might make something easier/better) so you have no idea how much help you have been by replying to my thread/posts!

 

[shknbk2]

Self-taught VBA is how I learned, so great job on your effort.

each sheet would need to be printed at some point in order to have the correct header/footer?

Yes, that would be the case for my new code: the header wouldn't get updated until the individual sheet gets printed. Using your original "For each" loop would do what you want to update all sheets, but it takes longer every time it runs.

Does the BeforeSave event run even when autosave happens or just when you manually save the file?

Unfortunately, it runs every time the AutoSave runs. See HERE. So, AutoSave isn't probably what you want.

You could have the "all sheets" version run when the workbook is opened, and then you could update each sheet before printing. This scenario is provided in the code below. This code goes in the ThisWorkbook module as you have probably been doing. Let me know if you don't understand the code.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    updateHeader ActiveSheet
End Sub


Private Sub Workbook_Open()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        updateHeader ws
    Next ws
End Sub


Sub updateHeader(ws As Worksheet)
    If ws.Range("A6").Value = "Income & Tax Summary" Or ws.Range("A6").Value = "Individual Tax Summary" Or ws.Range("A6").Value = "Tax Reconciliation (Company)" Or ws.Range("A6").Value = "Tax Reconciliation (Trust, Partnership)" Or ws.Range("A6").Value = "Tax Reconciliation (Sole Trader)" Then
        ws.PageSetup.LeftHeader = ""
        ws.PageSetup.LeftFooter = ""
        ws.PageSetup.CenterFooter = "&""Calibri""&I&8Liability limited by a scheme approved under Professional Standards Legislation"
        ws.PageSetup.RightFooter = ""
    ElseIf ws.Range("A6").Value = "Workpaper Index" Or ws.Range("A6").Value = "Work In Office Checklist" Then
        ws.PageSetup.LeftHeader = ""
        ws.PageSetup.LeftFooter = ""
        ws.PageSetup.CenterFooter = ""
        ws.PageSetup.RightFooter = ""
    ElseIf ws.Range("A6").Value = "Queries" Or ws.Range("A6").Value = "Review Points" Or ws.Range("A6").Value = "Issues for Next Year" Then
        ws.PageSetup.LeftHeader = ""
        ws.PageSetup.LeftFooter = "&""Calibri""&8" & ws.Range("B2").Value & "/" & "&F"
        ws.PageSetup.CenterFooter = "&""Calibri""&I&8Liability limited by a scheme approved under Professional Standards Legislation"
        ws.PageSetup.RightFooter = "&""Calibri""&8&A"
    ElseIf ws.Range("A6").Value = "Journal Entries" Or ws.Range("A6").Value = "Adjusting Journal" Then
        ws.PageSetup.LeftHeader = "&""Calibri""&B&14" & ws.Range("B1").Value
        ws.PageSetup.LeftFooter = "&""Calibri""&8" & ws.Range("B2").Value & "/" & "&F" & "/" & "&A"
        ws.PageSetup.CenterFooter = ""
        ws.PageSetup.RightFooter = "&""Calibri""&10&Page &P"
    Else
        Dim ref As String
        On Error Resume Next
        ref = ws.Range("WS_Ref").Value
        On Error GoTo 0
        ws.PageSetup.LeftHeader = "&""Calibri""&B&14" & ws.Range("B1").Value
        ws.PageSetup.LeftFooter = "&""Calibri""&8" & ws.Range("B2").Value & Chr(10) & "&F" & Chr(10) & "&A"
        ws.PageSetup.CenterFooter = "&""Calibri""&I&8Liability limited by a scheme approved under Professional Standards Legislation"
        ws.PageSetup.RightFooter = "&8Prepared by: " & ws.Range("Prepared_By").Value & Chr(10) & _
                                    "Reviewed by: " & ws.Range("Reviewed_By").Value & Chr(10) & _
                                    "Ref:   " & ref
    End If
End Sub

 

[Ana_P]

If I already have code under Workbook_Open event do i just add your code as is after it (but before End Sub)?

 

[Ana_P]

shknbk2 you're a legend!!

Your help has made me achieve exactly what I need!! I used the Workbook_Open event to run only once (if certain cells are blank an input box with prompts open to retrieve data from user and once that data is input then updateHeader runs - if data is present then no longer necessary) so that there isn't a lag each time the workbook is opened. The Workbook_BeforePrint works as needed also!

You have just made my day! Thanks a million for your help!!

 

[shknbk2]

That's great! Glad I could help.

 

[Ana_P]

shknbk2 you're a legend!!

Your help has made me achieve exactly what I need!! I used the Workbook_Open event to run only once (if certain cells are blank an input box with prompts open to retrieve data from user and once that data is input then updateHeader runs - if data is present then no longer necessary) so that there isn't a lag each time the workbook is opened. The Workbook_BeforePrint works as needed also!

You have just made my day! Thanks a million for your help!!

I have just realised there is something a little off with this in that when the Workbook_Open and updateHeader runs, the code uses Range A1 rather than B1 in the left header. This only corrects itself once the Workbook_BeforePrint even is run. As mentioned in a previous post, the idea behind the macro I created is that all the worksheets in the workbook are updated with the respective header/footer (so when print-previewing all the information is there). Instead of showing the client's name (value in B2) in the header it is currently showing "Client:" (value in B1). I believe the same thing was happening with the left footer also (showing "Code:" instead of the client's code). Is there any way to fix this?

Thanks!