Avatar of Andreas Hermle
Andreas Hermle
Flag for Germany asked on

Apply conditional formatting using VBA

Dear Experts:

The below macro enters the following formula into row 5 of the chosen formula column.

=IF(A5<>SUM(E5:G5);"Caution!";"ok") 'see line 6 of the code

The second inputbox prompts the user to enter another column letter which determines the number of rows the formula is copied down.

The macro then enters the formulas into all worksheets with the exception of a couple of them.

NOW, I also would like to apply conditional formatting to the entered formulas, i.e.

All Cells which have been filled with the term 'Caution!" should get a fill RGB 220, 17, 17 coupled with a white font

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Sub Enter_Formula_Multiple_Worksheets()
Dim ws As Worksheet
Dim rng As Range
Dim lr As Long, Col As Long
Dim Formula As String
Formula = "IF(A5<>SUM(E5:G5),""Caution!"",""ok"")"
Dim ColNameFormula As String
Dim ColNameCopyingDown As String

ColNameFormula = InputBox("Choose column letter where the formula will be entered", "Set Column Letter for formula")
If ColNameFormula = "" Then
MsgBox "You didn't select a column letter.", vbExclamation
Exit Sub
End If

ColNameCopyingDown = InputBox("Choose column letter to determine the number of copying down actions of the formula", "Set Column Letter")
If ColNameCopyingDown = "" Then
MsgBox "You didn't select a column letter.", vbExclamation
Exit Sub
End If

Application.ScreenUpdating = False
For Each ws In Worksheets
    Select Case ws.Name
         Case "1_Index", "2_Auswertung", "3_Gesamtliste", "X_Sorting", "Y_ColumnHeader", "Z_Requirements"
        
        Case Else
            lr = ws.Cells(Rows.Count, Range(ColNameCopyingDown & 1).Column).End(xlUp).Row
            If lr > 4 Then
                ws.Range(ws.Cells(5, Range(ColNameFormula & 1).Column), ws.Cells(lr, Range(ColNameFormula & 1).Column)).Formula = "=" & Formula
            End If
    End Select
    lr = 0
Next ws
Application.ScreenUpdating = True
End Sub

Open in new window

VBAMicrosoft ExcelMicrosoft Office

Avatar of undefined
Last Comment
Andreas Hermle

8/22/2022 - Mon
SOLUTION
Subodh Tiwari (Neeraj)

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Shums Faruk

Another approach would be:
Sub Enter_Formula_Multiple_Worksheets()
Dim ws As Worksheet
Dim rng As Range
Dim lr As Long, Col As Long
Dim Formula As String
Dim ColRng As Range
Formula = "IF(A5<>SUM(E5:G5),""Caution!"",""ok"")"
Dim ColNameFormula As String
Dim ColNameCopyingDown As String

ColNameFormula = InputBox("Choose column letter where the formula will be entered", "Set Column Letter for formula")
If ColNameFormula = "" Then
MsgBox "You didn't select a column letter.", vbExclamation
Exit Sub
End If

ColNameCopyingDown = InputBox("Choose column letter to determine the number of copying down actions of the formula", "Set Column Letter")
If ColNameCopyingDown = "" Then
MsgBox "You didn't select a column letter.", vbExclamation
Exit Sub
End If

Application.ScreenUpdating = False
For Each ws In Worksheets
    Select Case ws.Name
         Case "1_Index", "2_Auswertung", "3_Gesamtliste", "X_Sorting", "Y_ColumnHeader", "Z_Requirements"
        
        Case Else
            lr = ws.Cells(Rows.Count, Range(ColNameCopyingDown & 1).Column).End(xlUp).Row
            If lr > 4 Then
                ws.Range(ws.Cells(5, Range(ColNameFormula & 1).Column), ws.Cells(lr, Range(ColNameFormula & 1).Column)).Formula = "=" & Formula
            End If
            Set ColRng = ws.Range(ws.Cells(5, Range(ColNameFormula & 1).Column), ws.Cells(lr, Range(ColNameFormula & 1).Column))
            For Each cell In ColRng
                If cell.Value = "Caution!" Then
                    cell.Interior.Color = RGB(220, 17, 17)
                    cell.Font.Color = RGB(255, 255, 255)
                End If
            Next cell
    End Select
    lr = 0
Next ws
Application.ScreenUpdating = True
End Sub

Open in new window

Subodh Tiwari (Neeraj)

@shums

That is not conditional formatting but applying the cell interior color and form color explicitly. And the formatting done this way will remain even if the string returned by the formula gets changed.

But you never know, asker is smart enough to tweak all the codes as per his liking as he did in his last question and accepted your answer as an accepted one though he continued with the answer provided by me. :)

Also I am curious to know how did he tweak your last solution as per his requirement. :)
Shums Faruk

Oops. Oh Yes Neeraj, you are right.

Thanks for sharing.

Andreas, please ignore my code.
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
Andreas Hermle

ASKER
Hi Neeraj,

thank you very much for your quick and professional  help. I am afraid to tell you that your code throws an error message on column 36 (Runtime error 9, Index outside array).

As for your comments on the points awarding of my last question,

I will get back later this evening. Again, thank you very much for your great and professional help. I really appreciate it. The same applies to Shums
Shums Faruk

Andreas,

Try below:
Sub Enter_Formula_Multiple_Worksheets()
Dim ws As Worksheet
Dim rng As Range
Dim lr As Long, Col As Long
Dim Formula As String
Dim ColRng As Range
Formula = "IF(A5<>SUM(E5:G5),""Caution!"",""ok"")"
Dim ColNameFormula As String
Dim ColNameCopyingDown As String

ColNameFormula = InputBox("Choose column letter where the formula will be entered", "Set Column Letter for formula")
If ColNameFormula = "" Then
MsgBox "You didn't select a column letter.", vbExclamation
Exit Sub
End If

ColNameCopyingDown = InputBox("Choose column letter to determine the number of copying down actions of the formula", "Set Column Letter")
If ColNameCopyingDown = "" Then
MsgBox "You didn't select a column letter.", vbExclamation
Exit Sub
End If

Application.ScreenUpdating = False
For Each ws In Worksheets
    Select Case ws.Name
         Case "1_Index", "2_Auswertung", "3_Gesamtliste", "X_Sorting", "Y_ColumnHeader", "Z_Requirements"
        
        Case Else
            lr = ws.Cells(Rows.Count, Range(ColNameCopyingDown & 1).Column).End(xlUp).Row
            If lr > 4 Then
                ws.Range(ws.Cells(5, Range(ColNameFormula & 1).Column), ws.Cells(lr, Range(ColNameFormula & 1).Column)).Formula = "=" & Formula
            End If
            Set ColRng = ws.Range(ws.Cells(5, Range(ColNameFormula & 1).Column), ws.Cells(lr, Range(ColNameFormula & 1).Column))
            With ColRng
                .FormatConditions.Add xlTextString, String:="Caution!", TextOperator:=xlContains
                With .FormatConditions(.FormatConditions.Count)
                    .SetFirstPriority
                    With .Interior
                    .Color = RGB(220, 17, 17)
                    End With
                    With .Font
                    .Color = RGB(255, 255, 255)
                    End With
                End With
            End With
    End Select
    lr = 0
Next ws
Application.ScreenUpdating = True
End Sub

Open in new window

Andreas Hermle

ASKER
Oh great Shums, this did the trick, thank you very much for your great help. :-)

I will award the points later on ... :-)
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
ASKER CERTIFIED SOLUTION
Shums Faruk

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Andreas Hermle

ASKER
Neeraj, you wrote ... "But you never know, asker is smart enough to tweak all the codes as per his liking as he did in his last question and accepted your answer as an accepted one though he continued with the answer provided by me. :)"

It is always hard to award points. Shums answer on that specific question was correct and ok you are right, your code was the basis for my tweaking.  Again, awarding points equitably is not an easy task. Since Shum based his correct code on yours, I will award the majority of points to you. I hope I am doing everything right.

Thank you very much, Shums and Neeraj for your great help and support. I really appreciate it.

Regards, Andreas
Andreas Hermle

ASKER
I now decided to share the points 50:50, hope this is ok for both of you. Regards, Andreas