Add conditional formatting via VBA and loop through activesheet

[Andy15]

Hi guys,

Here's hoping somebody can assist in helping me modify an existing code shown below.
The current code adds some conditional formatting to an activesheet and is working great.

I need to add another bit of conditional formatting which is =AND(E22=B22,G22<d22 1.2)<="" font="">

The code needs to loop through the sheet and be added to every third column until the last column as the existing doc does

This is existing code that is working great.

[COLOR=#333333]Sub Add_Conditional_Formatting_2Letters()[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">    Dim LastCol As Long
    Dim NextCol As Long
    Dim rg As Range
    Dim s1 As String
    Dim s2 As String

    With ActiveSheet
        LastCol = .Cells(22, Columns.Count).End(xlToLeft).Column
        For NextCol = 7 To LastCol Step 3
            Set rg = .Range(Cells(22, NextCol), Cells(80, NextCol))
            s1 = Replace(rg.Offset(, -2).Address, "$", "")
            s2 = Replace(rg.Offset(, -5).Address, "$", "")
            With rg _
                    .FormatConditions.Add(Type:=xlExpression, _
                     Formula1:="=" & s1 & "<>" & s2)
                .Interior.Color = RGB(0, 204, 205) 'Blue
                .Font.Color = RGB(0, 0, 0) 'Black
            End With
        Next
    End With </code>[COLOR=#333333]End Sub[/COLOR]

This is code I have tried to modify without much success

[COLOR=#333333]Sub Add_Conditional_Formatting_2Lettersmodded()[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">    Dim LastCol As Long
    Dim NextCol As Long
    Dim rg As Range
    Dim s1 As String
    Dim s2 As String
    Dim s3 As String 'new line added
    Dim s4 As String 'new line added

    With ActiveSheet
        LastCol = .Cells(22, Columns.Count).End(xlToLeft).Column
        For NextCol = 7 To LastCol Step 3
            Set rg = .Range(Cells(22, NextCol), Cells(80, NextCol))
            s1 = Replace(rg.Offset(, -2).Address, "$", "")
            s2 = Replace(rg.Offset(, -5).Address, "$", "")
            s3 = Replace(rg.Offset(, 0).Address, "$", "") 'new line added
            s4 = Replace(rg.Offset(, -3).Address, "$", "") 'new line added
             
            With rg _
                    .FormatConditions.Add(Type:=xlExpression, _
                     Formula1:="=" & s1 & "<>" & s2)
                .Interior.Color = RGB(0, 204, 205) 'Blue
                .Font.Color = RGB(0, 0, 0) 'Black
            End With
            With rg _
                    .FormatConditions.Add(Type:=xlExpression, _
                     Formula1:="=" & "AND" & "(" & s1 & "=" & s2 & "," & s3 & "<" & s4 & "/" & "1.2") '=AND(E22=B22,G22<d22 1.2
                .Interior.Color = RGB(255, 0, 0) 'Blue
                .Font.Color = RGB(255, 255, 255) 'Black
            End With
        Next
    End With </d22></code>[COLOR=#333333]End Sub[/COLOR]

Many thanks for any help or advice given

Question also posted https://www.excelforum.com/excel-pr...and-loop-through-activesheet.html#post4633636
but unfortunately had no response.</d22>

 

[Norie]

How does the new code not work?

 

[Andy15]

Hi,

I get an Run time error '5':
Invalid procedure call or argument and when I enter Debug this section is highlighted

With rg _
                    .FormatConditions.Add(Type:=xlExpression, _
                     Formula1:="=" & "AND" & "(" & s1 & "=" & s2 & "," & s3 & "<" & s4 & "/" & "1.2")

Thanks

 

[Norie]

Have you checked that this produces a valid formula?

"=" & "AND" & "(" & s1 & "=" & s2 & "," & s3 & "<" & s4 & "/" & "1.2")

By the way, to get the address of a range without the $ you can use Address(0,0).

 s1 = rg.Offset(, -2).Address(0, 0)

 

[mas123]

Try this edited code

Sub Add_Conditional_Formatting_2Lettersmodded()
    Dim LastCol As Long
    Dim NextCol As Long
    Dim rg As Range
    Dim s1 As String
    Dim s2 As String
    Dim s3 As String 'new line added
    Dim s4 As String 'new line added


    With ActiveSheet
        LastCol = .Cells(22, Columns.Count).End(xlToLeft).Column
        For NextCol = 7 To LastCol Step 3
            Set rg = .Range(Cells(22, NextCol), Cells(80, NextCol))
            s1 = Replace(rg.Offset(, -2).Address, "$", "")
            s2 = Replace(rg.Offset(, -5).Address, "$", "")
            s3 = Replace(rg.Offset(, 0).Address, "$", "") 'new line added
            s4 = Replace(rg.Offset(, -3).Address, "$", "") 'new line added
             
            With rg _
                    .FormatConditions.Add(Type:=xlExpression, _
                     Formula1:="=" & s1 & "<>" & s2)
                .Interior.Color = RGB(0, 204, 205) 'Blue
                .Font.Color = RGB(0, 0, 0) 'Black
            End With
            With rg _
                    .FormatConditions.Add(Type:=xlExpression, _
                     Formula1:="=AND (" & s1 & "=" & s2 & "," & s3 & "<" & s4 & "/1.2)" '=AND(E22=B22,G22
		    .Interior.Color = RGB(0, 204, 205) 'Blue
                    .Font.Color = RGB(0, 0, 0) 'Black
	    End with
End Sub

 

[Andy15]

Hi mas123,

Unfortunately I still get the same error

 

[Andy15]

Hi Norie,

How would I check if it produces a valid formula?

 

[mas123]

It will be done, If you attach a file

 

[Norie]

Add this to the code judge before the line causing the error.

Debug.Print Formula1:="=" & "AND" & "(" & s1 & "=" & s2 & "," & s3 & "<" & s4 & "/" & "1.2")

That will output the formula to the Immediate Window (CTTL+G).

You can then copy the formula and paste it in a cell to see if it's valid.

 

[Andy15]

Hi Norie,

Sorry if i am not getting what I need to do but when I copy the Debug.Print before the formula as above I get the error "expected named parameter"