1
votes

I want to apply conditional formatting through VBA if column E contains for example 1ST then I want to use mutiple conditional formatting rules for the 28 cells next to it.

For this moment I use

Sub SetFormulasFormat()
With ActiveSheet
    For Each cl In Application.Intersect(.Columns("E"), .UsedRange)
        ' found upper row of the data in table
        If UCase(cl.Text) = "1ST" Then
                    cl.Resize(, 1).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
                     Formula1:="=1"
                    cl.Resize(, 1).FormatConditions(1).Interior.Color = vbRed
                    
                    cl.Resize(, 2).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
                     Formula1:="=3"
                    cl.Resize(, 2).FormatConditions(2).Interior.Color = vbRed
                

            End If
        
    Next cl
End With

End Sub

But I doesn't apply the second rule.

Example of my excel

enter image description here

Can someone help me?

2
Your code creates a CF rule that just checks if the cell value is 1 (or 3). are you trying to color the full row, based on if value in column E = 1ST?Foxfire And Burns And Burns
If the text is 1ST I need it to check if if column F is less than 1, then it needs to check if column G and H is less than 3 and for the other column other numbers if you know what I mean. It just needs to highlight the cel it needs to checkAäron Coene

2 Answers

1
votes

Try:

Sub SetFormulasFormat()
Application.ScreenUpdating = False
Dim cl As Range
With ActiveSheet
    For Each cl In Application.Intersect(.Columns("E"), .UsedRange)
        ' found upper row of the data in table
        If UCase(cl.Value) = "1ST" Then
            .Range("F" & cl.Row).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=1" 'apply CF rule to 1 single cell in same row
            .Range("F" & cl.Row).FormatConditions(1).Interior.Color = vbRed
            
            .Range("G" & cl.Row & ",H" & cl.Row).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=3" 'apply CF rule to 2 different cells in same row (Separate each cell with , like G2,H2...)
            .Range("G" & cl.Row & ",H" & cl.Row).FormatConditions(1).Interior.Color = vbRed
        End If
        
    Next cl
End With
Application.ScreenUpdating = True
End Sub

This will apply a single CF rule in each range you specify. I typed examples of creating CF rule in single cell or 2 cells, but you can adapt it to your needs.

0
votes

Variable Conditional Formatting

  • '* indicates where you have to change the code for other values instead of 1ST e.g. CUCA.

The Code

Option Explicit

Sub SetFormulasFormat()
    Const hRows As Long = 1
    Const cOffset As Long = 1
    Dim cl As Range
    
    Dim Offsets As Variant
    Offsets = Array(1, 2, 3)
    Dim firstValues As Variant
    firstValues = Array(1, 3, 5) '*
'    Dim cucaValues As Variant
'    cucaValues = Array(1, 3, 5) '*
    
    Dim cLower As Long: cLower = LBound(Offsets)
    Dim cUpper As Long: cUpper = UBound(Offsets)
    
    Dim fcols As Long: fcols = cUpper - cLower + 1
    With ActiveSheet
        Dim crg As Range
        With Intersect(.Columns("E"), .UsedRange)
            Set crg = .Resize(.Rows.Count - hRows).Offset(hRows)
        End With
    End With
    With crg
        .Resize(, fcols).Offset(, cOffset).FormatConditions.Delete
        Dim n As Long
        For Each cl In .Cells
            Select Case True
            Case UCase(cl.Value) = "1ST" '*
                For n = cLower To cUpper
                    With cl.Offset(, Offsets(n))
                        .FormatConditions.Add Type:=xlCellValue, _
                            Operator:=xlLess, Formula1:="=" & firstValues(n) '*
                        With .FormatConditions(1)
                            .Font.Color = vbWhite
                            .Interior.Color = vbRed
                        End With
                    End With
                Next n
'            Case UCase(cl.Value) = "CUCA" '*
'                For n = cLower To cUpper
'                    With cl.Offset(, Offsets(n))
'                        .FormatConditions.Add Type:=xlCellValue, _
'                            Operator:=xlLess, Formula1:="=" & cucaValues(n) '*
'                        With .FormatConditions(1)
'                            .Font.Color = vbWhite
'                            .Interior.Color = vbRed
'                        End With
'                    End With
'                Next n
            End Select
        Next cl
    End With
End Sub