Conditional Formatting subtotals(2003)

Topic

New Reply

Attached is a spreadsheet with three tabs. The first is raw data exported from Access into Excel. The second tab is the same data, after inserting subtotals, formatting fill and borders, and inserting text in a few locations. The third tab is the VBA code that formats the first sheet to look like the second sheet. I recorded a macro while in Excel, then took the resulting VB code and put it into Access, where I made a few required changes.

I am sure there is a better and programmatic way to do the formatting instead of the 700+ lines of code. What I am doing, and the order in which I am doing it is:
1. Export the data to Excel
2. Open Excel
3. Insert subtotals
4. Based on where the subtotals occur,
a) delete replicated data in Columns A and B
Insert text identifying the totals line
c) format column A and subtotal line with border and fill color
d) format column B and subtotal line with border and fill color and font type (underline)
5. Insert lines at top of sheet
6. Put title in A1

I am pretty sure there is a way to programmatically find the subtotal lines and then format the columns and cells based on the rows where the subtotals occur, but I don’t know how to find it, and once found how to tell Excel to fill, format etc. the cells with the appropriate color, border and fonts. In addition to the obvious drawback of a lot of lines of code, if a new continent, country or city is added in Access, when the data is exported to Excel the subtotals lines will no longer be in the same row, so the existing VBA code would be a disaster.

Is there a good place or resource to go to get ideas? Does anyone here have a suggestion?

Thanks in advance for your consideration.

Ken

Reply | Quote

Replies

I’m not going to analyze all your code, but you can use a loop to find all SUBTOTAL formulas in a column, e.g.

Dim oCell As Excel.Range
Dim strFirstAddress As String
Set oCell = .Range(“D:D”).Find(What:=”=SUBTOTAL”, LookIn:=xlFormulas, _
LookAt:=xlPart, MatchCase:=False)
If Not oCell Is Nothing Then
strFirstAddress = oCell.Address
Do
‘ Do your thing here
‘ …
Set oCell = .Range(“D:D”).FindNext(After:=oCell)
Loop While Not oCell Is Nothing And Not oCell.Address = strFirstAddress
End If

The .Range refers to the appropriate Excel object in your code.

One other remark: in general it isn’t necessary to select cells in code. For example, instead of

.Rows(“5:5”).Select
.Selection.Insert Shift:=xlDown

you can use

.Rows(“5:5”).Insert Shift:=xlDown

and instead of

.Range(“D129:J129”).Select
.Range(“A99:A129”).Select
With .Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With

you can use

With .Range(“A99:A129”).Interior
.ColorIndex = 34
.Pattern = xlSolid
End With

which is both shorter and more efficient. (Note that the first Select is omitted entirely since it isn’t used, the second Select overrides the first one)

Reply | Quote

Hans,

Thanks for the reply. I assumed there was a cleaner and more efficient way. I included the code, not for you to review, but to get an idea of how messy it is. I don’t have enough experience in Excel automation to know the shortcuts, but figured someone here would know or would know where I could go to get a better solution.

Thanks for taking time to respond. I’ll test and incorporate your approach tomorrow.

Ken

Reply | Quote

Hans,

Using your code and the Offset, I am able to accomplish the formatting. However, I am looping through a For/Next loop to do it (see below). Is there a way to capture the Row and Column from the “oCell” variable? That way I could identify the cells from left to right and format them all at once.

Thanks in advance for your consideration.

Ken

Set oCell = .Range(“D:D”).Find(what:=”=SUBTOTAL”, LookIn:=xlFormulas, _
LookAt:=xlPart, MatchCase:=False)
If Not oCell Is Nothing Then
strFirstAddress = oCell.Address

Do
‘ Insert blank line below subtotal
oCell.Offset(1, 0).EntireRow.Insert

‘ ========================================================================
‘ Format Subtotal line with medium underline and Yellow

For i = -2 To 7 Step 1
With oCell.Offset(0, i)
.Interior.ColorIndex = 36
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders.Weight = xlMedium

.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
With .Borders(xlEdgeTop)
.LineStyle = xlNone
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
.Borders(xlEdgeRight).LineStyle = xlNone
Next i
Set oCell = .Range(“D:D”).FindNext(After:=oCell)
Loop While Not oCell Is Nothing And Not oCell.Address = strFirstAddress
End If

Reply | Quote

oCell.Row is the row number of oCell, and oCell.Column the column number.

Reply | Quote

With that in mind, why is this the incorrect syntax to insert an entire row?
‘ Insert one line below the main subtotal here
oCell.Rows.Insert shift:=xlDown
For some reason, this inserts a cell, not a row. I probably overlooking something simple.

thanks,

Ken

oCell.Row is the row number of oCell, and oCell.Column the column number.

Reply | Quote

oCell.Rows returns a range consisting of all the rows in oCell, but since oCell is a single cell, this is equivalent to oCell itself.

Instead, use

oCell.EntireRow.Insert

(no need to specify Shift:=xlDown since that is the default when inserting an entire row.)

Reply | Quote

Excellent! If you would allow one additional question, if I wanted to insert a line AFTER oCell.EntireRow instead of above it, how would I modify the it?

Thanks for sharing your brilliance.

Ken

oCell.Rows returns a range consisting of all the rows in oCell, but since oCell is a single cell, this is equivalent to oCell itself.

Instead, use

oCell.EntireRow.Insert

(no need to specify Shift:=xlDown since that is the default when inserting an entire row.)

Reply | Quote

if I wanted to insert a line AFTER oCell.EntireRow instead of above it, how would I modify the it?

Try

oCell.Offset(1, 0).EntireRow.Insert

Reply | Quote

Yes sir. That worked perfectly!

THANKS.

Try

oCell.Offset(1, 0).EntireRow.Insert

Reply | Quote