View Full Version : Conditional Formatting and VB
Odyrus
06-14-2013, 10:18 AM
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!
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
06-17-2013, 05:12 AM
SamT, thanks for the info. I will play with this. Much appreciated!
Odyrus
06-19-2013, 09:13 AM
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?
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
06-19-2013, 09:52 AM
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!
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
06-20-2013, 05:13 AM
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?
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
06-28-2013, 06:49 AM
Thanks for providing some direction.
:beerchug:
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.