Forgive because this will be a lot of code. The overall point to all of
this code is to update the header and footer based upon entires made on
the HeaderPage worksheet. The code pulls the entries made and populates
the header and footer on all worksheets with in the workbook. The issue
is that it has to loop through each worksheet when activated and can
take some time to complete. Is there anything I can do to this to speed
it up?

The code below is found in two parts.

The following code is found in ThisWorkbook:


Code:
--------------------
Private Sub Workbook_BeforePrint(Cancel As Boolean)
'this code repeats the header and footer code for each worksheet
'this code drives the warning for the user if they exceed the number of allowable H/F bytes
'this code is triggered every time a user tries to print or print preview
Const c_intMaxHdrLen As Integer = 232

Dim wkSht As Worksheet

If Range("HdrLen") c_intMaxHdrLen Then
MsgBox "Your Header exceeds 232 characters. Please go back to the header page and reduce the # of Characters"
Cancel = True
Exit Sub
End If

Application.ScreenUpdating = False
For Each wkSht In ThisWorkbook.Worksheets
SetHeader wkSht
Next wkSht
Application.ScreenUpdating = True
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'this code repeats the header and footer code for each worksheet
'this code drives the warning for the user if they exceed the number of allowable H/F bytes
'this code is triggered every time a user tries to save
Const c_intMaxHdrLen As Integer = 232

Dim wkSht As Worksheet

If Range("HdrLen") c_intMaxHdrLen Then
MsgBox "Your Header exceeds 232 characters. Please go back to the header page and reduce the # of Characters"
Cancel = True
Exit Sub
End If

Application.ScreenUpdating = False
For Each wkSht In ThisWorkbook.Worksheets
SetHeader wkSht
Next wkSht
Application.ScreenUpdating = True
End Sub
--------------------


The next code is found in Module 1


Code:
--------------------
Sub SetHeader(Sh As Worksheet)
' this code takes data from the header page
'and populates it to the header and footer
Dim lStr As String
Dim rStr As String
Dim dStr As String
Dim eStr As String
Dim tStr As String

With Worksheets("HeaderPage")
Application.ScreenUpdating = False
'defines where the data is coming from on the header page and what the format is
lStr = "&8" & .Range("K2") & vbCr & .Range("K3") & vbCr & .Range("K4") & vbCr & .Range("K5")
rStr = "&8" & .Range("M2") & vbCr & .Range("M3") & vbCr & .Range("M4") & vbCr & .Range("M5") & vbCr & .Range("M6")
dStr = "&8" & .Range("M11")
eStr = "&6" & .Range("W1") & vbCr & .Range("W2") & vbCr & .Range("W3") & vbCr & .Range("W4")
tStr = "Page " & "&P" & " of " & "&N"
End With

With Sh.PageSetup
.LeftHeader = lStr
.CenterHeader = dStr
.RightHeader = rStr
.CenterFooter = eStr
.RightFooter = tStr
End With

With ActiveSheet.PageSetup
'resets the top and bottom margins to accomodate the new header
.TopMargin = Application.InchesToPoints(1.24)
.BottomMargin = Application.InchesToPoints(1)
Sheets("Instructions").Visible = False

End With
End Sub
--------------------


--
retseort
------------------------------------------------------------------------
retseort's Profile: http://www.excelforum.com/member.php...o&userid=24690
View this thread: http://www.excelforum.com/showthread...hreadid=500187