I think the only reason this macro doesn't work is because the first row is
a header row.
It took me awhile to figure it out. It compares, cells (irow, 16) =
(irow,16 -1) to see if it is a new deparment. If it doesn't match it is a
new department. It works on every row except the last one, the top row.
Since the first row is a header not a real line the first row count should
start on row 2. Can you help me fix this. I think after that it should
create a header row on every new department even the last one (2nd row).
THANKS,

-----
Public Sub ColorDivHeaders()

Dim firstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim sDeptName As String
Dim sStatusName As String
Dim sNextDeptID
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 .Cells(iRow, 16).Value = .Cells(iRow - 1, 16).Value Then

' if the department is the same as previous
'create the status headers


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, 3).Value = sDeptName

.Cells(iRow, 3).Font.Bold = True
.Cells(iRow, 3).Font.Size = 14
.Cells(iRow, 3).RowHeight = 18
End If
Next iRow


End With
End Sub

hey all, I found the problem on my own, sorry for the posts. The whole
problem I didn't see was the firstrow = 2 line.
I changed it to the
firstroww = 1 line and it works no, hacks.
Thanks,

"Janis" wrote:


I think the only reason this macro doesn't work is because the first row is
a header row.
It took me awhile to figure it out. It compares, cells (irow, 16) =
(irow,16 -1) to see if it is a new deparment. If it doesn't match it is a
new department. It works on every row except the last one, the top row.
Since the first row is a header not a real line the first row count should
start on row 2. Can you help me fix this. I think after that it should
create a header row on every new department even the last one (2nd row).
THANKS,

-----
Public Sub ColorDivHeaders()

Dim firstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim sDeptName As String
Dim sStatusName As String
Dim sNextDeptID
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 .Cells(iRow, 16).Value = .Cells(iRow - 1, 16).Value Then

' if the department is the same as previous
'create the status headers


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, 3).Value = sDeptName

.Cells(iRow, 3).Font.Bold = True
.Cells(iRow, 3).Font.Size = 14
.Cells(iRow, 3).RowHeight = 18
End If
Next iRow


End With
End Sub