troubleshooting Question

Apply conditional formatting using VBA

Avatar of Andreas Hermle
Andreas HermleFlag for Germany asked on
VBAMicrosoft ExcelMicrosoft Office
10 Comments2 Solutions181 ViewsLast Modified:
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
ASKER CERTIFIED SOLUTION
Shums
Excel VBA Developer
Join our community to see this answer!
Unlock 2 Answers and 10 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 2 Answers and 10 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros