Excel macros page breaks but not on row 1 and column value in footer

M

misscrf

Hi, I have seen some posts that are similar, but no one seems to have
the problem that I am having. I will post my macro in this, for anyone
that is interested.

My users get a csv file every month, and we have to clean it up. This
macro does that.

My last issues are this:

1) having the spreadsheet create page breaks whenever the value in
column B changes. Below is just that code.

Code:
col = 2
LastRw = ActiveSheet.UsedRange.Rows.Count
For X = 2 To LastRw
If Cells(X, col) <> Cells(X - 1, col) And Cells(X, col) <> Range("B1")
Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(X, col)
End If
Next
----------------------------------


The problem that I am having, is that my first page is just row 1. I
have row 1 repeat at the top of every page. It does make sense in the
code that this value changes, so it makes a page break. Can anyone help
me to adjust my code so that it will ignore the first row when it makes
the page breaks? The value of B1 will always be the same, so my thought
is to make that "If ...Then" statement include something that says not
if Cells(X, col) = B1. Make sense?

Second issue:

2) I want to take the value in column B, as it will be the same for any
given page due to the above page breaks, and put that in the footer.

I have commented out the code that I was having fun with trying. The
idea is that column B is a box number, and I want to have that box
number in the footer, so that it is easy to see on the sheet. Here is
my page setup code for headers and footers.

As I said, I commented out the right footer where I would put this
code. Any help would be great.


Code:
With ActiveSheet.PageSetup
.CenterHeader = "Our Form"
.LeftFooter = Date
.CenterFooter = "Signature __________________________________"
' this is where I want the value --> .RightFooter = "Box Number: "
& Column("B:B").Value
End With
---------------------------
From the posts I have been reading, you cannot use formulas in the
footer. I wish this was not true. My idea was that many formulas or
functions could work here. Because I break the page on the value in
this column any function that finds the value of any B column cell in
the page could be used in this right footer. Like first or last would
work.

Anyway, if I cannot get this second part, I can still deploy the macro.
I just need to fix the first part.

For anyone who is interested, here is my entire messy code. I started
off with what we had, recorded portions to do more, and added bits and
pieces together.
Be warned that I am not advanced at Excel macros, so it is a messy one.

It is not organized at all, but it works!

Code:
Sub MyCsvConvert()

Application.ScreenUpdating = False
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.FormulaR1C1 = "Date " & Chr(10) & "Entered"
With ActiveCell.Characters(Start:=1, Length:=13).Font
End With
Range("A1").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.FormulaR1C1 = "SKP " & Chr(10) & "Box #"
Columns("B:B").Select
Selection.ColumnWidth = 9.2
Range("B1").Select
With Selection
.HorizontalAlignment = xlRight
End With
Columns("C:G").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.FormulaR1C1 = "Dept. #"
Range("C1").Select
With Selection
.HorizontalAlignment = xlRight
End With
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.FormulaR1C1 = "Record " & Chr(10) & "Code"
With ActiveCell.Characters(Start:=1, Length:=12).Font
End With
Range("D1").Select
With Selection
.HorizontalAlignment = xlRight
End With
Columns("E:G").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.ColumnWidth = 9.17
Range("E1").Select
With Selection
.HorizontalAlignment = xlCenter
End With
ActiveCell.FormulaR1C1 = "Destruction " & Chr(10) & "Date"
With ActiveCell.Characters(Start:=1, Length:=17).Font
End With
Range("F1").Select
Columns("F:F").ColumnWidth = 9.5
Columns("F:G").Select
With Selection
.HorizontalAlignment = xlLeft
End With
Columns("H:I").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.ColumnWidth = 21.5
'Columns("I:I").ColumnWidth = 21.5
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
'ActiveWindow.SmallScroll ToRight:=6
Columns("I:J").Select
Selection.ColumnWidth = 21.5
'Columns("K:K").ColumnWidth = 21.5
Columns("K:M").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.LargeScroll ToRight:=-1
Range("C1").Select
ActiveCell.FormulaR1C1 = "Depart #"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Atty Number"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Client Number"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Matter Number"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Client Name"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Matter/File Descrip"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Real/Est Collect Numer"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Closing Date"
Columns("I:I").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("H:H").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("J:J").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("H:H").ColumnWidth = 34.57
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("F1").Select
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight,
RegionIndex:=1
ActiveWindow.LargeScroll ToRight:=-1
Cells.Select
Selection.Copy
Workbooks.Add Template:="Workbook"
ActiveSheet.Paste
ActiveSheet.PageSetup.Orientation = xlLandscape
With Worksheets(1).PageSetup
.LeftMargin = Application.InchesToPoints(0.35)
.RightMargin = Application.InchesToPoints(0.35)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintGridlines = True
ActiveWindow.View = xlNormalView
With ActiveSheet.PageSetup
.CenterHeader = "Our Form"
.LeftFooter = Date
.CenterFooter = "Signature __________________________________"
' this is where I want the value --> .RightFooter = "Box Number: "
& Column("B:B").Value
End With
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Columns("F:F").ColumnWidth = 9.29
Columns("F:F").ColumnWidth = 7
Columns("F:F").ColumnWidth = 6.29
Columns("F:F").ColumnWidth = 5.57
Columns("F:F").EntireColumn.AutoFit
Columns("F:F").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 9.43
Selection.ColumnWidth = 7.71
Columns("G:G").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 9.43
Selection.ColumnWidth = 8
Selection.ColumnWidth = 7.29
Columns("I:I").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 15.57
Selection.ColumnWidth = 12.71
Selection.ColumnWidth = 11
Columns("J:J").ColumnWidth = 25.86
Columns("J:J").ColumnWidth = 28.29
Range("H2").Select
ActiveCell.FormulaR1C1 = "M &amp; T MORTGAGE CORPORATION"
With ActiveCell.Characters(Start:=1, Length:=30).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.Replace What:="&amp;", Replacement:="&", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False
Rows("1:1").Select
Selection.Font.Bold = True
Range("D1").Select
Columns("D:D").ColumnWidth = 7.71
Columns("E:E").ColumnWidth = 7.43
Range("I1").Select
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Columns("B:B").Select
Range("A1:J81").sort Key1:=Range("B2"), Order1:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
col = 2
LastRw = ActiveSheet.UsedRange.Rows.Count
For X = 2 To LastRw
If Cells(X, col) <> Cells(X - 1, col) And Cells(X, col) <> Range("B1")
Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(X, col)
End If
Next
If Not ActiveWorkbook.Saved Then
ThisWorkbook.Saved = True
ThisWorkbook.Close
End If

End Sub
 
E

Earl Kiosterud

crf,

One thing to keep in mind is that the code is going through the sheet
putting in page breaks, not through pages. So the rows to repeat at top
shouldn't be involved. I think you can change it to:

For X = 3 to lastRw

As for the second part, the same thing applies. Anything you put in the
footer is for the whole print job. And footers aren't dynamic (can't pick
up changing data). One possibility is to print each group of col B values
as a separate print job, setting the footer as desired in code each time.
This may create a lot of separator pages if this is a network printer. You
wouldn't need the page breaks in the part 1 code for this solution. You
could do it by setting the print area for the group to be printed, or by
hiding the rows that shouldn't print, or by copying the rows to another
sheet and printing that.
 
E

Earl Kiosterud

crf,

Another possibility that comes to mind is to separate the groups into
sheets, setting the footers as desired for each sheet, then print the
workbook. One print job, getting around the multiple-print-job issue, like
with the separator pages. This might get a bit unwieldy if you have a lot
of groups, but there's no limit as to how many sheets a workbook can have.
We can help with the code.
--
Earl Kiosterud
www.smokeylake.com

Earl Kiosterud said:
crf,

One thing to keep in mind is that the code is going through the sheet
putting in page breaks, not through pages. So the rows to repeat at top
shouldn't be involved. I think you can change it to:

For X = 3 to lastRw

As for the second part, the same thing applies. Anything you put in the
footer is for the whole print job. And footers aren't dynamic (can't pick
up changing data). One possibility is to print each group of col B values
as a separate print job, setting the footer as desired in code each time.
This may create a lot of separator pages if this is a network printer.
You wouldn't need the page breaks in the part 1 code for this solution.
You could do it by setting the print area for the group to be printed, or
by hiding the rows that shouldn't print, or by copying the rows to another
sheet and printing that.
 
M

misscrf

These sound like good suggestions, thanks. I got better code for the
page breaks. I think I may have to give up on the footer.

Here is my amended code for the page breaks:

Dim FromSheet As Worksheet
Dim LastRow As Long
Dim MyValue As Variant
Dim EndPage As Range
'----------------------------------------------------
Set FromSheet = Worksheets("Sheet1")
LastRow = FromSheet.Range("A65536").End(xlUp).Row
FromRow = 2
'-----------------------------------------------------
'- main loop
Do
MyValue = FromSheet.Cells(FromRow, 2).Value
'- start ToSheet anew
ToRow = 2
'--------------------------------------------------------------
'- set page breaks
While FromSheet.Cells(FromRow, 2).Value = MyValue
FromRow = FromRow + 1
Wend
Set EndPage = FromSheet.Cells(FromRow, 1)
FromSheet.HPageBreaks.Add Before:=EndPage
Loop While FromRow <= LastRow

'-------------------------------------------------------------------
'- print sheet
With FromSheet.PageSetup
.CenterHeader = "Iron Mountain Inventory Form"
.LeftFooter = Date
.CenterFooter = "Signature _______________________________"
.RightFooter = "Box Number: " & MyValue
End With

-------------

I will probably have to take out the MyValue stuff. It is giving me
the value in column B on the last page, but for every page. If I can't
figure out how to trick it, I will have to omit it.

It is unfortunate.
Thanks.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top