MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

Excel database report with formatting problems

  Asked By: Jenna    Date: Feb 20    Category: MS Office    Views: 941

I'm trying to add header rows to an excel database to output as a

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
sStatusName = .Cells(iRow, 18).Value
.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

'if the department is a new department add the row header
sDeptName = .Cells(iRow, 17).Value
.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



No Answers Found. Be the First, To Post Answer.

Didn't find what you were looking for? Find more on Excel database report with formatting problems Or get search suggestion and latest updates.