macro script conditional formatting

Copper Contributor

I'm trying to create a macro that will shade entire rows a color based on a cell value. I tried using conditional formatting but it seems to only work on my 1st rule. How do I do this for multiple rules?

10 Replies
I would recommend asking this question in the Excel community where it will be seen by people with that expertise.
Thanks. I've moved this question to the Excel community.

Hi Diana,

 

Could you please give bit more details what exactly doesn't work. In general good practice is one color-one rule for entire range, the rest is how do you apply the formula.

I tried recording a macro with multiple conditional formatting. The end result should be that 1st for any date in column O occurring today the entire row should be shaded red, 2nd for any date in column occurring tomorrow the entire row should be shaded orange, and 3rd any date in column occurring this week then the entire row should be shaded light blue. Everything else remains unshaded. When I look at the macro script the the 2nd and 3rd options don't record and when I try to run the macro the red shading doesn't shade the correct rows.

Alternatively you could code without conditional formatting:

 

Sub BackColor()

Mydate = Date

Select Case Cells(1, 15).Value
Case Mydate
Range("A1:O1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = vbRed
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Case DateAdd("d", 1, Mydate)
Range("A1:O1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = vbGreen
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Case Else
Range("A1:O1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = vbBlue
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Select

End Sub

Perhaps it would help if I put what I have 1st.  See below. Everything else works fine except the shading. How do I change this so that the shading works properly and that the 2nd and 3rd shading options run?

 

Sub PEVersionStatus2()
'
' PEVersionStatus2 Macro
'

'
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Rows("1:4").Select
Selection.Copy
Selection.Font.Bold = True
Range("B1").Select
ActiveCell.FormulaR1C1 = "Report Run Date"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Cells.Select
Cells.EntireColumn.AutoFit
Range("A4").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Add Key:=Range _
("O5:O500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Add Key:=Range _
("N5:N500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Add Key:=Range _
("M5:M500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("O:O").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("O4").Select
ActiveCell.FormulaR1C1 = "Priority"
Range("O5").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[1]-R2C2=0,""Today"",IF(RC[1]-R2C2=1,""Tomorrow"",IF(RC[1]-R2C2=2,""48Hrs"","""")))"
Range("O5").Select
Selection.AutoFill Destination:=Range("O5:O500")
Range("O5:O500").Select
ActiveWindow.SmallScroll Down:=0
Cells.Select
Range("H1").Activate
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$P5=TODAY()"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
ActiveSheet.Range("$A$4:$Y$500").AutoFilter Field:=11, Criteria1:=Array( _
"DT", "PN", "RP", "="), Operator:=xlFilterValues
End Sub

I tried applying your code but it shaded the entire worksheet blue.

Hi Excel experts, I could really use some help with this macro. Pleaseeee

Maybe the theme color doesn't meet your need?

If you select the range before you apply the background colour it won't turn the whole sheet blue.