I'm trying to add header rows to an excel database to output as a
report.
There are 2 if/then blocks. One creates a gray row with the header of
the department name. The second if/then creates darker gray rows for
the status fields.
Basically the algorithm is doing what I want except it leaves off the
department header on the first row.
The formatting problem is it creates the name of the status field in
every cell on the row in the else (2nd if/then statement) instead of
horizontally centering the text (status name) centered across the row.
A minor problem is the name of the department is supposed to go in
cell number 4 only maybe centering in that cell only. This department
name field is also repeating in every cell across the row.
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 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
' create the status row headers
If .Cells(iRow, 19).Value = .Cells(iRow - 1, 19).Value Then
' do nothing
Else
sStatusName = .Cells(iRow, 18).Value
.Rows(iRow).Insert
.Range(.Cells(iRow, 1), .Cells(iRow, 26)).Interior.ColorIndex = 48
.Range(.Cells(iRow, 1), .Cells(iRow, 26)).Font.Bold = True
.Range(.Cells(iRow, 1), .Cells(iRow, 26)).Value = sStatusName
End If
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
.Range(.Cells(iRow, 1), .Cells(iRow, 26)).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