pagebreaks after last department in a group, color header on first

[Janis]

Can someone help me with the page breaks?

This macro creates a gray row header for the first department line of each
group of departments. I need it to page break after the last department in a
group. Since this macro starts at the bottom and goes up to create the rows
do I need another separate macro to do the page breaks since I want to go
(down) instead of up to the last one in each department. This macro goes
(up) to the first department and creates a gray row.
Since I now have the row headers it no longer is arranged in database fields.

The other problem is that it does not put a gray row header on the very
first row. Presumably because it has no next line to compare itself with on
the first row. Should I just add a row header for the first line since
that will always be the first row for that department? Is that the way to do
it?

Thanks

Public Sub ColorHeaders()

Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim sDeptName As String
Dim sStatusName As String
Dim sPrevDeptID
Dim sDeptID
Dim rng As Range
With ActiveWorkbook.Worksheets("Sheet1")
FirstRow = 2
LastRow = .Cells(.Rows.Count, 16).End(xlUp).Row
For iRow = LastRow To FirstRow + 1 Step -1

sDeptID = .Cells(iRow, 16)
sNextDeptID = .Cells(iRow + 1, 16)
'first if block creates the Item Name headers

If sDeptID <> sNextDeptID Then .Rows(iRow).PageBreak = xlPageBreakManual

If .Cells(iRow, 16).Value = .Cells(iRow - 1, 16).Value Then
'do nothing if the department is the same as previous


Else
'if the department is a new department add the row header
sDeptName = .Cells(iRow, 17).Value
.Rows(iRow).Insert
.Range(.Cells(iRow, 1), .Cells(iRow, 26)).Interior.ColorIndex = 15

.Cells(iRow, 4).Value = sDeptName
.Cells(iRow, 4).Font.Bold = True
.Cells(iRow, 4).Font.Size = 14
.Cells(iRow, 4).RowHeight = 18

End If
Next iRow
End With

End Sub

 

[ChristopherTri]

No and yes... I think.

Try this:

Public Sub ColorHeaders()

Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim sDeptName As String
Dim sStatusName As String
Dim sPrevDeptID
Dim sDeptID
Dim rng As Range
With ActiveWorkbook.Worksheets("Sheet1")
FirstRow = 2
LastRow = .Cells(.Rows.Count, 16).End(xlUp).Row
For iRow = LastRow To FirstRow + 1 Step -1

sDeptID = .Cells(iRow, 16)
sNextDeptID = .Cells(iRow + 1, 16)
'first if block creates the Item Name headers

If sDeptID <> sNextDeptID Then .Rows(iRow+1).PageBreak = xlPageBreakManual

If .Cells(iRow, 16).Value = .Cells(iRow - 1, 16).Value Then
'do nothing if the department is the same as previous


Else
'if the department is a new department add the row header
sDeptName = .Cells(iRow, 17).Value
..Rows(iRow).Insert
..Range(.Cells(iRow, 1), .Cells(iRow, 26)).Interior.ColorIndex = 15

..Cells(iRow, 4).Value = sDeptName
..Cells(iRow, 4).Font.Bold = True
..Cells(iRow, 4).Font.Size = 14
..Cells(iRow, 4).RowHeight = 18

End If
Next iRow


..Range(.Cells(1, 1), .Cells(iRow, 26)).Interior.ColorIndex = 15

..Cells(1, 4).Value = sDeptName
..Cells(1, 4).Font.Bold = True
..Cells(1, 4).Font.Size = 14
..Cells(1, 4).RowHeight = 18

End With

End Sub