Modification of Code

[jim may]

Allen Wyatt (on his site) has created the below Code and it works GREAT.

Sub PageBreak()
    Dim CellRange As Range
    Dim TestCell As Range

    Set CellRange = Selection
    For Each TestCell In CellRange
        ActiveSheet.Rows(TestCell.Row).PageBreak = xlPageBreakNone
        If TestCell.Value <> TestCell.Offset(-1, 0).Value Then
            ActiveSheet.Rows(TestCell.Row).PageBreak = xlPageBreakManual
        End If
    Next TestCell
    With ActiveSheet
        .PrintPreview
    End With
End Sub

Is there anyway it can be MODIFIED (the above) to On Each Previewd Page (Grouped BY Dept) that I can Create a Page Header and in it
Reference the "Department Field Name" being Currently Printed (below on that page)?

Thanks in Advance...

Jim

 

[shg]

How about ...

Sub PrintByDept()
  Dim wks           As Worksheet
  Dim rBeg          As Range
  Dim cell          As Range
  Dim sDept         As String

  Set wks = ActiveSheet
  wks.Cells.PageBreak = xlPageBreakNone

  With Intersect(ActiveWindow.RangeSelection, wks.UsedRange)

    Set rBeg = .Cells(1)
    sDept = rBeg.Value

    For Each cell In .Cells
      If cell.Value <> sDept Then
        With wks.PageSetup
          .PrintArea = Intersect(Range(rBeg, cell.Offset(-1)).EntireRow, wks.UsedRange).Address
          .LeftHeader = sDept
        End With
        wks.PrintPreview
        Set rBeg = cell
        sDept = rBeg.Value
      End If
    Next cell
  End With
End Sub

 

[jim may]

shg,

Thank for code.

Jim May
With KPMG - Corpus Christi, TX (1969-1971)

 

[shg]

You're welcome, Jim.