Variable Print Header

[Glaswegian]

Seems to be my day for asking questions.....

I will be printing a large number of report pages from a workbook (around 500) and these will all go in our internal mail system to various Managers etc. I had thought that I could add the required details to the sheet Header via code, but I'm not sure how to do this (or even if it can be done).

I know I can place a cell value in the Header, so I'd thought of using a table containing the required addresses, but I don't know how to link that to the reports. The address table will have a matching field in each report. Each report will have a varying number of pages, e.g some will have only 1 page, some will have 4 or more. All page breaks and page style etc have been set by code.

Page 1 will go to Manager A at location B, pages 2 -6 will go to Manager C at location D and so on. Each Manager has a unique ID code.

Is there a way to add the address for each Manager to the print Header so that each print have the correct address for that Manager?

Thanks as always for any help.

[Richie(UK)]

Hi Iain,

Yes, you can set the Header and Footer details by code. You may find, however, that the code is very slow (especially with the number of sheets that you are referring to).

The following code (provided to me by Ivan Moala, I think) is a much quicker alternative. It adds the same info to every sheet but hopefully you can adapt it to suit your needs - let me know if you need help. The variables are, I think, quite intuitive - strLH is the String variable for the Left Header etc.

Sub CustomHeaderFooterV3()
Dim ws As Worksheet
Dim strLH As String, strCH As String, strRH As String
Dim strLF As String, strCF As String, strRF As String
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
With Sheet1
    strLH = "&L" & .Range("C43").Value
    strCH = "&C" & .Range("C44").Value
    strRH = "&R" & .Range("C45").Value
    strLF = "&L" & .Range("C46").Value
    strCF = "&C" & .Range("C47").Value
    strRF = "&R" & .Range("C48").Value
End With
'get values from Sheet1 (User Input)
For Each ws In ThisWorkbook.Worksheets
    ws.Activate
    ws.DisplayPageBreaks = False
    Application.SendKeys "{ENTER}", False
    Application.Dialogs(xlDialogPageSetup).Show _
        Arg1:=strLH & strCH & strRH, _
        Arg2:=strLF & strCF & strRF
Next
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
Sheet1.Activate
End Sub

HTH

[Glaswegian]

Hi again Richie


Many thanks for your reply - superb code!

A bit over my head now, so any further assistance would be gratefully received.

I've attached a small sample sheet, just with bare data. The 'List' sheet shows some data - this will be split according to the ID code in column A. Is it possible to adapt your code so that for each ID Code, the address(from the 'Lookup' sheet) is dropped into the Header?

I have some similar other sheets but once I get the initial method I should be OK.

Regards

[Richie(UK)]

Hi Iain,

Well, not tested, because I don't have access to a printer at the moment, but perhaps something like this:

Sub CustomHeaderFooterV3()
    Dim ws As Worksheet
    Dim strLH As String, strCH As String, strRH As String
    Dim strLF As String, strCF As String, strRF As String
    Dim rngCell As Range, rngData As Range, rngAdd As Range
With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
Set rngAdd = Range("Addresses")
    'named range
With Worksheets("List")
        Set rngData = .Range("A6:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) _
            .SpecialCells(xlCellTypeConstants, xlNumbers)
For Each rngCell In rngData
            strCH = "&C" & Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 2)
'            strLH = "&L" & .Range("C43").Value
'            strCH = "&C" & .Range("C44").Value
'            strRH = "&R" & .Range("C45").Value
'            strLF = "&L" & .Range("C46").Value
'            strCF = "&C" & .Range("C47").Value
'            strRF = "&R" & .Range("C48").Value
For Each ws In ThisWorkbook.Worksheets
                ws.Activate
                ws.DisplayPageBreaks = False
                Application.SendKeys "{ENTER}", False
                Application.Dialogs(xlDialogPageSetup).Show _
                Arg1:=strLH & strCH & strRH, _
                Arg2:=strLF & strCF & strRF
            Next
'do the printing
Next rngCell
End With
With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

With the named range referring to the data on the 'Lookup' sheet.

HTH

[Glaswegian]

Richie



Many thanks - like the code and understand most of it. I've tried to amend it to suit but I'm getting a bit stuck. Also I don't quite follow the show Dialog box bit - I have to click on 'OK' to clear. This is what I've got so far - I've added a loop to look at the ID numbers in Col A and skip if they are the same - seems to be OK. My main problem is trying to print the correct pages with the correct header. I think I'm nearly there but I'm now getting errors like 'Block If without End If' and 'Invalid Next Control variable reference'. I can't seem to work this out and would appreciate any help.

Thanks

Sub CustomHeaderFooterV3()
    Dim ws As Worksheet
    Dim strLH As String, strCH As String, strRH As String
    Dim strLF As String, strCF As String, strRF As String
    Dim rngCell As Range, rngData As Range, rngAdd As Range
    Dim i As Integer, x As Long
With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
Set rngAdd = Range("BranchAddress")
     'named range
     x = Worksheets("Test Print").HPageBreaks.Count
    With Worksheets("Test Print")
        Set rngData = .Range("A6:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) _
        .SpecialCells(xlCellTypeConstants, xlNumbers)
For Each rngCell In rngData
            If rngCell.Value <> rngCell.Offset(-2, 0).Value Then
            strLH = "&B" & "&16" & Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 2) & " " _
            & Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 1)
'            For Each ws In ThisWorkbook.Worksheets
'                ws.Activate
                Application.SendKeys "{ENTER}", False
                Application.Dialogs(xlDialogPageSetup).Show _
                Arg1:=strLH
'            Next
                For i = 1 To x
                    Worksheets("Test Print").Activate
                    ActiveSheet.PrintOut from:=i, To:=x - (x - i), copies:=1
            'End If
Next rngCell
        Next i
    End With
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

[Richie(UK)]

Hi Iain,

A quick reply only, I'm afraid, as I'm just about to leave the office for a while.

The SendKeys with Enter part was to OK the dialog box as it looped through each sheet (SendKeys isn't generally a good idea as it's not reliable, but it's part of the speed workaround in this code) - try adding it after the dialog box.

You have commented-out the End If line.

You have mixed-up the Next rngCell and Next i lines.

[Glaswegian]

Ok - think I've got most bits sorted.



I've now got a problem in that I can't get x to increment, it stays at 1. Each ID will have a variable number of pages, and I think printing after applying the variable header is the best way (at least only one I can come up with). Here is the code so far

Sub CustomHeaderFooterV3()
    Dim strLH As String, strCH As String, strRH As String
    Dim strLF As String, strCF As String, strRF As String
    Dim rngCell As Range, rngData As Range, rngAdd As Range
    Dim i As Integer, x As Long
With Application
        .ScreenUpdating = False
    End With
Set rngAdd = Range("TestAddress")
     'named range
     x = Worksheets("Test Print").HPageBreaks.Count
    With Worksheets("Test Print")
        Set rngData = .Range("A6:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) _
        .SpecialCells(xlCellTypeConstants, xlNumbers)
For i = 1 To x
            For Each rngCell In rngData
                If rngCell.Value <> rngCell.Offset(-2, 0).Value Then
                strLH = "&B" & "&16" & Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 2) & " " _
                & Application.WorksheetFunction.VLookup(rngCell.Value, rngAdd, 1)
Application.Dialogs(xlDialogPageSetup).Show _
                Arg1:=strLH
                Application.SendKeys "{ENTER}", False
                    Worksheets("Test Print").Activate
                    ActiveSheet.PrintOut from:=i, To:=x - (x - i), copies:=1
                End If
            Next rngCell
        Next
    End With
    With Application
        .ScreenUpdating = True
    End With
End Sub

Thanks again for all assistance.