Date Inserted in header

[Mark C via OfficeKB.com]

What i have is a macro that formatts the sheet that I run when I start
working on a sheet. What i am wondering is how to have it put todays date in
the center header box. Curently i have it putting in a 4 to hold the text
sizr formatting. **The text in the left headder is changed from actual
infomation because it contains compay information. But the one thing is that
the date cannot change. Once the date has been put in there i need it to
always be the same. Here is the macro Any help is very appreciated. Thank
you!!

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

'
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "AKER****** "
.CenterHeader = "&20 4"
.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.00"
Selection.NumberFormat = "0.000"

End Sub

 

[Mike Fogleman]

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

 

[Mark C via OfficeKB.com]

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]

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]

Works Great!!

When I had tested it I had some text in the center header.

Thank you very Much!!!!

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

Is There a way to make it so that the date will not change. The way it
seems

[quoted text clipped - 70 lines]