Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 360
Default pagebreaks after last department in a group, color header on first

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 49
Default pagebreaks after last department in a group, color header on first

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

"Janis" wrote:

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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Automating Department Payroll Howard R Excel Discussion (Misc queries) 4 March 5th 07 01:07 PM
I can't select/edit objects. It says [Group] on the header bar. Tomba Excel Discussion (Misc queries) 2 March 30th 06 12:09 PM
Add to a cell if a row has a date and a column has a department Craigm[_38_] Excel Programming 2 August 6th 05 07:23 AM
Calculating Working Days - Department of Pathology Andrea Excel Discussion (Misc queries) 1 July 20th 05 07:20 PM
How to use Macro throughout Department Dave Peterson[_5_] Excel Programming 0 March 22nd 05 12:16 AM


All times are GMT +1. The time now is 10:25 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"