Conditional Formatting and VB

[Odyrus]

Hello,

I need to format a range of cells from A6 through some row in column H based on 2 conditions.

1. If there is a cell in column A that is bold I would like to format the row to column H as bold and shade it some color. Color type is unimportant.

2. If there is a cell in column A which equals 'Grand Total' I need to replicate condition 1 but with a different shade. Color is unimportant.


Any thoughts on accomplishing this are most welcomed!

[SamT]

What if Cell value is 'Grand Total' and it is Bold? Play with order of IF statement as needed.

The following is not Code! It is pseudocode, ie. Thoughts about code.
For each Cel in Range(A6 to A+LastRow)
IF Cel.Font.Bold = True Then
With Cel.Resize(0,6)
.Font=Bold
.Interior.ColorIndex = (1 of 3 to 56) '1 & 2 are black and white
End With
Else If Cel = 'Grand Total' Then
With Cel.Resize(0,6)
.Font=Bold
.Interior.ColorIndex = (1 other of 3 to 56) '1 & 2 are black and white
End With
End If
Next

If you need more, let us know.:hi:

[Odyrus]

SamT, thanks for the info. I will play with this. Much appreciated!

[Odyrus]

I'm wondering now if there is a variable I can specify right after the code I use to add subtotals:

LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A5:H" & LastRow).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5, 6, 7), Replace:=True, PageBreaks:=False, SummaryBelowData:=True

Thoughts?

[SamT]

I'm wondering now if there is a variable I can specify right after the code I use to add subtotals:
Of course there is

Dim X as Reply
X = "Not enough information"

[Odyrus]

Ha! That confused me at first. Then I had a good laugh at myself.

So.. soup to nuts here is my code:


Sub LeadSummary()

Application.ScreenUpdating = False

'clear outline
Columns("A:H").Select
Application.CutCopyMode = False
Selection.ClearOutline
Selection.Font.Bold = False

'update column headers

Range("D5").Select
ActiveCell.FormulaR1C1 = "At1t"

Range("E5").Select
ActiveCell.FormulaR1C1 = "Ap1"

Range("F5").Select
ActiveCell.FormulaR1C1 = "Pending"

Range("G5").Select
ActiveCell.FormulaR1C1 = "Made"

Range("H5").Select
ActiveCell.FormulaR1C1 = "Ratio"

Range("A5:H5").Select
Selection.Font.Bold = True


'add subtotals

LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A5:H" & LastRow).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5, 6, 7), Replace:=True, PageBreaks:=False, SummaryBelowData:=True

Cells.Select
Cells.EntireColumn.AutoFit



'add Ratio Formula

Range("H6").Select
ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-3]/RC[-4]),"""",(RC[-3]/RC[-4]))"
Range("H6").Select
Selection.Copy
Range("H7:H1000").Select
ActiveSheet.Paste

'add foot notes

lMaxRows = Cells(Rows.Count, "a").End(xlUp).Row + 2
Range("a" & lMaxRows + 1).Select
ActiveCell = "*PLaceholder"
With ActiveCell
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Name = "Arial"
.WrapText = False
End With

lMaxRows = Cells(Rows.Count, "a").End(xlUp).Row
Range("a" & lMaxRows + 1).Select
ActiveCell = "Footnotes:"
With ActiveCell
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Name = "Arial"
.WrapText = False
End With


lMaxRows = Cells(Rows.Count, "a").End(xlUp).Row
Range("a" & lMaxRows + 1).Select
ActiveCell = "Placeholder"
With ActiveCell
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Name = "Arial"
.WrapText = False
End With

lMaxRows = Cells(Rows.Count, "a").End(xlUp).Row
Range("a" & lMaxRows + 1).Select
ActiveCell = "Placeholder"
With ActiveCell
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Name = "Arial"
.WrapText = False
End With

lMaxRows = Cells(Rows.Count, "a").End(xlUp).Row
Range("a" & lMaxRows + 1).Select
ActiveCell = "Placeholder"
With ActiveCell
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Name = "Arial"
.WrapText = False
End With


'paste special values

Columns("A:H").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Range("A1").Select
ActiveCell.FormulaR1C1 = "TITLE PAGE"

' Range("A2").Select
' ActiveCell.FormulaR1C1 = "Text"

Range("A1:H3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
End With
With Selection.Font
.Size = 14
End With
Selection.Font.Bold = True

Application.ScreenUpdating = True

End Sub

This formats out put from a SAS dataset. My goal is to format the subtotals and the grand totals so that they stick out. The only discerning characteristic I can think of is that the subtotals will be bold. So I thought to format the rows based off that. And of course the Grand Total row. The recipients of this report are extremely finicky with how it looks else I wouldn't bother.

I appreciate any assistance you can lend mate!

[SamT]

On a blank sheet put some numbers in D6 to Gn

Option Explicit

Sub LeadSummary()

Dim LastRowData As Long 'Used to find last row of data
LastRowData = Range("H" & Rows.Count).End(xlUp).Row
Dim LastRowA As Long 'Used to clear "Placeholder" Rows
LastRowA = Range("A" & Rows.Count).End(xlUp).Row
Dim LastRowS As Long 'Used to clear Subtotal Rows 'Not used ATT
LastRowS = Range("D" & Rows.Count).End(xlUp).Row

Dim Cels As Range 'Note Variable spelling

Dim RatForm As String 'Ratio Formula
RatForm = "=IF(ISERROR(E6/D6),"""",E6/D6)"

Application.ScreenUpdating = False
Application.CutCopyMode = False

'clear old SubTotaling
Columns("A:H").Font.Bold = False
If LastRowA > LastRowData Then _
Range(Range("A" & (LastRowData + 1)), Range("H" & LastRowA)).ClearContents

'update column headers
Range("A5:H5").Font.Bold = True
Range("D5") = "At1t"
Range("E5") = "Ap1"
Range("F5") = "Pending"
Range("G5") = "Made"
Range("H5") = "Ratio"

'add subtotals
Range("A5:C5") = "Temp_Label" 'Used to suppress "Labels" Error
Range("A5:G" & LastRowData).Subtotal GroupBy:=1, _
Function:=xlSum, _
TotalList:=Array(4, 5, 6, 7)
Range("A5:C5") = ""

'Add Ratio Formula
Range("H6").Formula = RatForm
Range("H6:H" & LastRowData).FillDown

'add foot notes 3 Rows below Subtotals
Set Cels = Cells(Rows.Count, 1).End(xlUp).Offset(3).Resize(5)
With Cels
.HorizontalAlignment = xlHAlignLeft
.VerticalAlignment = xlVAlignBottom
.Font.Name = "Arial"
.WrapText = False
.Cells(1) = "*Placeholder" 'Cels is a single column Range, so
.Cells(2) = "Footnotes:" 'Cels.Cells(n) is the nth [Cell|Row] in the Range(Cels)
.Cells(4) = "*Placeholder"
.Cells(5) = "*Placeholder"
End With

'PasteSpecial = Values
Columns("A:H").Copy
Columns("A:H").PasteSpecial Paste:=xlPasteValues 'Other params' default values used

'Insert "Title"
Range("A1:H3").Merge
With Range("A1")
.Value = "TITLE PAGE"
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
.Font.Size = 14
End With

Cells.Columns.AutoFit
Columns("A:H").ClearOutline

Application.CutCopyMode = True
Application.ScreenUpdating = True
End Sub

[Odyrus]

SamT,

Your code is much cleaner than mine, thanks mate! It work well, too.

I'm still running into the same problem though. I need to format the subtotal and grand total rows so they are colored. (I know, it seems meaningless, alas...)

In your opinion what is the best way to implement this formatting, and how would I do it? Use bold font as a key or something? What are your thoughts?

[SamT]

Expect errors for you to fix.
Sub example()
Dim LastRowData As Long 'Used to find last row of data
LastRowData = Range("H" & Rows.Count).End(xlUp).Row
Dim LastRowA As Long 'Used to clear "Placeholder" Rows
LastRowA = Range("A" & Rows.Count).End(xlUp).Row 'Not used ATT
Dim LastRowS As Long 'Now used to color Subtotal Rows

Const FstSTLblCol As Long = 1 'Col "A" 'Change here as needed to effect code below
Const LstSTLblCol As Long = 3 'Col "C"
Const FstDataCol As Long = 4 'Col"D"
Const LstDataCol As Long = 8 'Col "H"
'
'Existing code including "add subtotals" code
'
'Move this line to here
LastRowS = Range("D" & Rows.Count).End(xlUp).Row

'Color Subtotal values
Range(Cells(LastDataRow + 1, FstDataCol), Cells(LastRowS, LstDataCol) _
.Interior.ColorIndex(1 of 3-56) '1 & 2 are black and white

'Color Subtotal Labels
Range(Cells(LastDataRow + 1, FstSTLblCol), Cells(LastRowS, LstSTLblCol) _
.Interior.ColorIndex(1 other of 3-56) '1 & 2 are black and white

End Sub

[Odyrus]

Thanks for providing some direction.

:beerchug: