Ugh fry your squash problem....VBA code suddenly ignored

[retseort]

Hello all,

The code at issue is supposed to pull data from cells located on what I call the HeaderPage worksheet and populate the header/footer. It should run on all subsequent worksheets where the header and footer on those sheets is also populated with the same cell data from the HeaderPage worksheet.

The below code is two parts

PART 1 -This is found in ThisWorkbook - It controls the module 1 code to run BeforePrint and BeforeSave

CODE:

Private Sub Workbook_BeforePrint(Cancel As Boolean)

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)

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

************************************************** ***********
PART 2 This code is found in Module 1 and it is what gets run when the Before Print and BeforeSave events are activated.

Please note that the PART 2 is ran on all sheets when subbed.

CODE:

Dim lStr As String
Dim rStr As String
Dim dStr As String
Dim eStr As String

With Worksheets("HeaderPage")
Application.ScreenUpdating = False
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")
End With

With sh.PageSetup
.LeftHeader = lStr
.CenterHeader = dStr
.RightHeader = rStr
.CenterFooter = eStr
End With

With ActiveSheet.PageSetup
.TopMargin = Application.InchesToPoints(1.24)
.BottomMargin = Application.InchesToPoints(1)
Sheets("Instructions").Visible = False

End With
End Sub

************************************************** *******

THE ISSUE:

When I sub this to run either by trying to print or by saving, the HeaderPage sheet is the only one where the header and footer properly update. All subsequent sheets drop the center header and the first line of the center footer.

It would appear that excel is ignoring part of the code. I can't figure out why. Interestingly enough the dStr and eStr parts of the above code are cloe to eachohter with in the code and it seems to be ignoring all of the dStr and the first range in the eStr.

Can you tell me why? This was working fine at one point.

Thanks
Dan

 

[just_jon]

dStr = "&8" & Range("M11")
eStr = "&6" & Range("W1") & vbCr & .Range("W2") & vbCr & .Range("W3") & vbCr & .Range("W4")


In the above are you not missing some of the period prefix's to the Ranges?