Mark: That is exactly what this code does. You will input the date once in
the inputbox. The IF statement checks the length of the center header string
and if it is greater than 4 characters, does nothing and skips to End If.
For example if the header displays 2006, then the center header string is
"&20 2006". including the space, that is 8 characters. Since 8 is 4,
nothing happens and the 2006 stays intact. If there are 4 characters or less
then the header is empty ("") or only has the font size property but no text
("&20 "). If that is true, then the input box will ask you to enter a date,
which is then put into the header. The next time the macro is run, it will
see 8 characters in the header and do nothing.
The first time you run this macro the center header must be empty. If you
still have the "4" there, clear it out manually in the View/ Header Footer
menu.

Mike F
"Mark C via OfficeKB.com" <u12467@uwe wrote in message
news:5be1a1164e6ee@uwe...
Is There a way to make it so that the date will not change. The way it
seems
to be working the date will change as the date changes. I need it to stay
on
the date to stay on the date it was put in the headder.

Mike Fogleman wrote:
You will need to store the date somewhere on the sheet. The code below
will
store it in the far right cell of row 1. You will only need to enter it
once
for each new sheet.

Sub HeadderFooter()
'
' Macro1 Macro
' Macro recorded 8/17/2005 by cwa9821
'

'
Dim HdrDate As String
If Len(ActiveSheet.PageSetup.CenterHeader) 4 Then
'do nothing
Else
Range("IV1").Value = InputBox("Enter Header Date")
HdrDate = Range("IV1").Value
ActiveSheet.PageSetup.CenterHeader = "&20 " & HdrDate
End If

With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "AKER****** "
.RightHeader = ""
.LeftFooter = "By: MCone"
.CenterFooter = "&F"
.RightFooter = "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1.83)
.BottomMargin = Application.InchesToPoints(0.8)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Selection.Merge Application.Dialogs(xlDialogPageSetup).Show
Range("A1").Select
ActiveCell.FormulaR1C1 = "See Markup of Attached Drawings for Shot
Locations "
Range("A1").Select
Selection.Font.Bold = True
Range("B1").Select
ActiveCell.FormulaR1C1 = "0"
Range("b1:R100").Select
Selection.NumberFormat = "0.000"
Range("A1").Select
End Sub

Mike F

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200602/1