Macro for page breaks - not on row header - value footer?

[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. Be warned that I am not advanced at Excel macros, so it is a messy one.

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.

      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, it is breaking on the row header for the first page. I have row A 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?


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 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.

  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

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.

It is not organized at all, but it works!

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 & 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:="&", 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

Thanks!

 

[BrianB]

Bit of a different approach. Your method fails with respect to the footer which will only retain the final setting. This transfers each data set to another worksheet, prints it, then clears for the next. You could adapt it to put everything into separate sheets, but I see no benefit in that.

There is the added advantage that ToSheet can be preformatted and used over again.

'===========================================================
'- PRINT A DATA TABLE INTO SEPARATE SHEETS OF PAPER
'- DEPENDING ON CONTENT
'- Brian Baulsom October 2005
'============================================================
'-
Sub test()
    Dim FromSheet As Worksheet
    Dim FromRow As Long
    Dim LastRow As Long
    Dim MyValue As Variant
    Dim CopyRange As Range
    '----------------------------------------------------
    Dim ToSheet As Worksheet
    Dim ToRow As Long
    Dim rg As String
    '----------------------------------------------------
    Set FromSheet = Worksheets("Sheet1")
    LastRow = FromSheet.Range("A65536").End(xlUp).Row
    Set ToSheet = Worksheets("Sheet2")
    FromRow = 2
    '-----------------------------------------------------
    '- main loop
    Do
        Application.StatusBar = " Processing " & FromRow & " / " & LastRow
        MyValue = FromSheet.Cells(FromRow, 2).Value
        '- start ToSheet anew
        ToRow = 2
        '--------------------------------------------------------------
        '- transfer matching records
        While FromSheet.Cells(FromRow, 2).Value = MyValue
            Set CopyRange = _
                FromSheet.Range(Cells(FromRow, 1), Cells(FromRow, 10))
            rg = "A" & ToRow    ' reduce work done by next line
            CopyRange.Copy Destination:=ToSheet.Range(rg)
            FromRow = FromRow + 1
            ToRow = ToRow + 1
        Wend
        '--------------------------------------------------------------
        '- print sheet
        With ToSheet.PageSetup
            .CenterHeader = "Our Form"
            .LeftFooter = Date
            .CenterFooter = "Signature _______________________________"
            .RightFooter = "Box Number: " & MyValue
        End With
        ToSheet.PrintOut
        '--------------------------------------------------------------
        '- clear ToSheet
        With ToSheet
            .Range(.Cells(2, 1), .Cells(ToRow, 10)).Clear
        End With
    Loop While FromRow <= LastRow
    '------------------------------------------------------------------
    '- finish
    MsgBox ("Done")
    Application.StatusBar = False
End Sub

 

[misscrf]

This took me a minute to understand what you were accomplishing. I can see if they will allow me to separate the data onto separate sheets, but I think they want it all together.

My thought is to use a formula in the footer that would just look for any cell in column B on any 1 page and make that value the footer. I would think that this would work, because the value will only be 1 value per page, as it breaks on the page.

If this won't work, then I will have to back burner it for now.

As for the page breaks, I do need to solve this, and I don't think your solution will solve the issue.

The code that I have cleans up the whole spreadsheet, sorts it, and breaks the pages. The only problem is, that it gives me the first page with just row 1, because row 1 is the column header, and is repeated on every page. I just want to trick that to ignore the first row, and break when the column value changes, just not if the value is what B1 is (which will never change - B1 will always be "Box #").

 

[BrianB]

Here is the same code revised to put page breaks.
Using this method it is not possible to do change the footer the way you want.

'===========================================================
'- PUT PAGE BREAKS
'============================================================
'-
Sub PageBreaks()
    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
        Application.StatusBar = " Processing " & FromRow & " / " & LastRow
        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 = "Our Form"
        .LeftFooter = Date
        .CenterFooter = "Signature _______________________________"
        .RightFooter = "Box Number: " & MyValue
    End With
    FromSheet.PrintOut
    '------------------------------------------------------------------
    '- finish
    MsgBox ("Done")
    Application.StatusBar = False
End Sub

 

[misscrf]

Hey, thanks for the reply. I don't get something though. You said in your post that with this method I would not be able to do the footer I want. But you gave me code that gives me a footer on every page for the value of the last box in my series.

I think your code is really good, and it makes me think that this has to be possible. Can't I somehow trick the code to look at the value of any cell in column B on each page and say, on the current page the footer = B? It could look at the first cell in b or the last. or the middle. it doesnt matter.

It could look at the average, as they would all be the same, so the average would be itself.

lol.

Any thing else you can do to help?

This is great. Thanks again.

 

[BrianB]

But you gave me code that gives me a footer on every page for the value of the last box in my series.

Yes, I left it there for illustration - but it is overwrtitten each time to leave the final value. This was my point with the code I supplied earlier.

 

[misscrf]

Oh, I'm sorry. That makes sense. I am hearing from everywhere on forums that this is the case. I believe I will be giving up on this part of the macro.

Thanks for your help.