Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!
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);"Cautio
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
The below macro enters the following formula into row 5 of the chosen formula column.
=IF(A5<>SUM(E5:G5);"Cautio
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
Do more with
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Please try...
Sub Enter_Formula_Multiple_Worksheets()
Dim ws As Worksheet
Dim rng As Range
Dim lr As Long, Col As Long, cnt 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
Set rng = ws.Range(ws.Cells(5, Range(ColNameFormula & 1).Column), ws.Cells(lr, Range(ColNameFormula & 1).Column))
cnt = ws.Cells.FormatConditions.Count
ws.Range(ws.Cells(5, Range(ColNameFormula & 1).Column), ws.Cells(lr, Range(ColNameFormula & 1).Column)).Formula = "=" & Formula
With rng
.FormatConditions.Add Type:=xlTextString, String:="Caution!", TextOperator:=xlContains
.FormatConditions(cnt + 1).Font.Color = vbWhite
.FormatConditions(cnt + 1).Interior.Color = RGB(220, 17, 17)
End With
End If
End Select
lr = 0
Next ws
Application.ScreenUpdating = True
End Sub
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
@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. :)
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. :)
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
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
Andreas,
Try below:
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
Oh great Shums, this did the trick, thank you very much for your great help. :-)
I will award the points later on ... :-)
I will award the points later on ... :-)
You're always Welcome Andreas! No problem. Actually I learned Format Condition from Neeraj's code :)
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
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
Premium Content
You need an Expert Office subscription to comment.Start Free Trial