Apply CF rules via VBA

[Afarag]

Hi,

I have a VBA code that let me applying CF rule in a range,

but face a problem that prevent the code from doing his job as well

the CF is based on Function which complex somewhat

I have 3 formulas

1 >> set Yellow color 2 >> set Red color 3 >> set Green color

When release the Code the "Green" color only that apply and to preview the other 2 color should Open "CF Rules Manager" then double click in each Rule to open pop out "Edit Formatting Rule" to click "OK" then at last click "Apply"

Is there solvable in editing the VBA code?

I'm Use office 2013

Code:

Sub CF_01()
'July 11, 2014
    With Range("E5:BP300")
        .FormatConditions.Delete
       
       
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=IF(ISNUMBER($DA5),ISNUMBER(MATCH(E$2,IF(HC=""lunch"",INDEX(TD,$DA5,0)),0)))"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior      'FormatConditions(1) This was correct.
            .PatternColorIndex = xlAutomatic
            .Color = RGB(255, 255, 0) '<< yellow
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = True        'FormatConditions(1)
   
   
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=IF(ISNUMBER($DA5),ISNUMBER(MATCH(E$2,IF(HC=""break"",INDEX(TD,$DA5,0)),0)))"
        .FormatConditions(.FormatConditions.Count).SetLastPriority
        With .FormatConditions(2).Interior      'FormatConditions(2)
            .PatternColorIndex = xlAutomatic
            .Color = RGB(255, 0, 0) '<< red
            .TintAndShade = 0
        End With
        .FormatConditions(2).StopIfTrue = True      'FormatConditions(2)
   
   
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=IF(ISNUMBER($DA5),IF(ISNA(MATCH(E$2,IF(HC=""break"",INDEX(TD,$DA5,0)),0))," _
            & "IF(E$2>=INDEX(TD,$DA5,1)," _
            & "IF(E$2<IF(INDEX(TD,$DA5,COLUMNS(TD))=0,1,INDEX(TD,$DA5,COLUMNS(TD))),1,0),0),0),0)"
        .FormatConditions(.FormatConditions.Count).SetLastPriority
        With .FormatConditions(3).Interior      'FormatConditions(3)
            .PatternColorIndex = xlAutomatic
            .Color = RGB(0, 255, 0) '<< green
            .TintAndShade = 0
        End With
        .FormatConditions(3).StopIfTrue = True      'FormatConditions(3)
   
   
    End With
End Sub

 

[Luke M]

Hi Afarag,
I don't think I understood your question. Your macro appears to be setting your CF conditions correctly. Is it not working on your end? Or, were you wanting something else to happen? Or, were you wanting the code to open the CF Manager?

 

[Afarag]

Hi Luke,

the objective is if i create the above rules manually it go true but there is a problem when i applied them with the above code, when i release the code the green color only that applied but the other need to apply manually,

but i tried another Code and go well , thanks for your following
Code:

Sub CF_PT()
Dim i As Long
Dim arrF1(1 To 5) As String
Dim arrClr(1 To 5) As Long
Dim fc As FormatCondition
Dim rng As Range

    arrF1(1) = "=(E$2=INDEX(TD,$DA5,MATCH(""Lunch"",HC,0)))"
    arrF1(2) = "=(E$2=INDEX(TD,$DA5,MATCH(""Lunch1"",HC,0)))"
    arrF1(3) = "=(E$2=INDEX(TD,$DA5,MATCH(""break"",HC,0)))"
    arrF1(4) = "=(E$2=INDEX(TD,$DA5,MATCH(""break1"",HC,0)))"
    arrF1(5) = "=IF(ISNUMBER($DA5),IF(ISNA(MATCH(E$2,IF(HC=""break"",INDEX(TD,$DA5,0)),0))," _
              & "IF(E$2>=INDEX(TD,$DA5,1)," _
              & "IF(E$2<IF(INDEX(TD,$DA5,COLUMNS(TD))=0,1,INDEX(TD,$DA5,COLUMNS(TD))),1,0),0),0),0)"

    arrClr(1) = RGB(255, 255, 0)
    arrClr(2) = RGB(255, 255, 0)
    arrClr(3) = RGB(255, 0, 0)
    arrClr(4) = RGB(255, 0, 0)
    arrClr(5) = RGB(0, 255, 0)

    Set rng = Range("E5:BP300")
    rng.FormatConditions.Delete
    rng.Activate

    For i = 1 To 5
        Set fc = rng.FormatConditions.Add(Type:=xlExpression, Formula1:=arrF1(i))
        fc.Interior.Color = arrClr(i)
        fc.Priority = i
        fc.StopIfTrue = False
    Next
End Sub