Is there a way to create a conditional formatting loop in VBA?-CodePudding

I have a large table spanning from D5 to AM39. Each column has its average value in cell D40, E40, F40, etc. I want to format the cells so that if the number in that column is higher than the average, color green and if lower color red.

I am extremely new to VBA but have this script thus far that is supposed to color cells greater than average but does not work (I think it has something to do with Cells(4,39) index being wrong, but am not sure.

Application.CutCopyMode = False

With Range(Cells(5, 39), Cells(4, 39))
  .FormatConditions.Delete

  .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
    Formula1:="=$D40"
 .FormatConditions(1).Interior.color = RGB(0, 150, 0)

End With
End Sub

Appreciate any tips

EDIT********

Using the record macro feature I believe I have a closer solution to what I am looking for, however, the formatting doesn't align with the averages per row (cells are red that should be green, and vice versa)

With Range(Cells(39, 4), Cells(5, 39)).Select
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
    Formula1:="=D$40"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
    .color = -16752384
    .TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .color = 13561798
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
    Formula1:="=D$40"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
    .color = -16383844
    .TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .color = 13551615
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
  End With
  End Sub

CodePudding user response：

Try this (using the built-in "compare to average" CF feature)

Sub AddCF()
    
    Dim rngData As Range, col As Range
    
    Set rngData = ActiveSheet.Range("D5:AM39") 'your table data

    Application.ScreenUpdating = False
    For Each col In rngData.Columns            'for each column in the data range
        With col.FormatConditions.AddAboveAverage  'for >Avg
            .AboveBelow = xlAboveAverage
            .Interior.Color = vbRed
        End With
        With col.FormatConditions.AddAboveAverage  'for <Avg
            .AboveBelow = xlBelowAverage
            .Interior.Color = 5296274
        End With
    Next col
    
End Sub

If you want to use your existing average formulas:

Sub AddCF2()
    
    Dim rngData As Range, col As Range, addr
    
    Set rngData = ActiveSheet.Range("D5:AM39")

    Application.ScreenUpdating = False
    For Each col In rngData.Columns 'for each column in the data range
        'absolute row, relative column address
        addr = col.Cells(col.Cells.Count).Offset(1).Address(True, False) 'avg cell address
    
        With col.FormatConditions
            With .Add(Type:=xlCellValue, Operator:=xlGreater, Formula1:="=" & addr)
                .Font.Color = -16383844
                .Interior.Color = 13551615
            End With
            With .Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=" & addr)
                .Font.Color = -16752384
                .Interior.Color = 13561798
            End With
        End With
    Next col
    
End Sub