Forum Discussion

Diana Delaney-Francis's avatar
Diana Delaney-Francis
Copper Contributor
Nov 13, 2018

macro script conditional formatting

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 ru...
SergeiBaklan's avatar
SergeiBaklan
Diamond Contributor
Nov 13, 2018

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.

Diana Delaney-Francis's avatar
Diana Delaney-Francis
Copper Contributor
Nov 14, 2018

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.

  • Diana Delaney-Francis's avatar
    Diana Delaney-Francis
    Copper Contributor
    Nov 19, 2018

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

  • John Keleher's avatar
    John Keleher
    Copper Contributor
    Nov 14, 2018

    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

    • Diana Delaney-Francis's avatar
      Diana Delaney-Francis
      Copper Contributor
      Nov 16, 2018

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

      • John Keleher's avatar
        John Keleher
        Copper Contributor
        Nov 23, 2018

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

    • Diana Delaney-Francis's avatar
      Diana Delaney-Francis
      Copper Contributor
      Nov 14, 2018

      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

Resources