Friday, November 15, 2019

excel - VBA Conditional Formatting



I am struggling to figure out an elegant way to apply conditional formatting rules via VBA. I prefer VBA because a) the rules will apply to multiple worksheets, and b) it prevents the CF duplication problem when copying/pasting between worksheets.




I have a list of inventory items, all kept in different locations. I want to format based on location with the following formatting:



Font color (will change for each location); Top border (same color as font); Bottom border (same color as font)



Also, the range needs to be dynamic in that for each worksheet, it applies to the table on that sheet. I would like to apply the same code to each applicable worksheet, rather than needing to hard-code the table name for each worksheet.



Any help would be greatly appreciated.







--UPDATE--
I tried to adapt J_V's code here but receive a "Run-time error '5': Invalid procedure call or argument" on the Public Sub's r.FormatConditions.Add Type:=xlExpression, Formula1:=formula. I'm unsure if the last bit on borders is correct since the run-time stops the macro. I also still need to work in dynamic table references, but I'm working one issue at a time.



Sub ConditionalFormatting()

Dim myRange As Range
Set myRange = ThisWorkbook.Sheets("Widget1").Range("Widget1_table[Location]")

myRange.FormatConditions.Delete


Call FormatRange(myRange, 10, "=$E5="Warehouse1")
Call FormatRange(myRange, 11, "=$E5="Warehouse2")
Call FormatRange(myRange, 13, "=$E5="Warehouse3")

End Sub

Public Sub FormatRange(r As Range, color As Integer, formula As String)
r.FormatConditions.Add Type:=xlExpression, Formula1:=formula
r.FormatConditions(r.FormatConditions.Count).Font.colorindex = color


With r.FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.Color = color
.TintAndShade = 0
.Weight = xlThin
End With
With r.FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.Color = color
.TintAndShade = 0

.Weight = xlThin
End With
r.FormatConditions(1).StopIfTrue = False

End Sub

Answer



The problem is not actually within Sub FormatRange but in the way you are assigning the formula when calling it within Sub ConditionalFormatting. The formula contains a string so the quotes have to be doubled up like this.



Sub ConditionalFormatting()

Dim myRange As Range
Set myRange = ThisWorkbook.Sheets("Widget1").Range("Widget1_table[Location]")

myRange.FormatConditions.Delete

Call FormatRange(myRange, 10, "=$E5=""Warehouse1""")
Call FormatRange(myRange, 11, "=$E5=""Warehouse2""")
Call FormatRange(myRange, 13, "=$E5=""Warehouse3""")
End Sub



As to the second macro, when you add a new condition it goes to the bottom of the queue. If you look at the recorded output from creating a CF rule you will see that it typically contains the line,



    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority


This puts the CF rule at the top of the queue so that it can thereafter be referred to as .FormatConditions(1). If you do not want it at the top of the queue then you have to refer to it as the last in the queue like this.



Public Sub FormatRange(r As Range, clr As Integer, frml As String)
r.FormatConditions.Add Type:=xlExpression, Formula1:=frml

r.FormatConditions(r.FormatConditions.Count).Font.ColorIndex = clr

With r.FormatConditions(r.FormatConditions.Count).Borders(xlTop)
.LineStyle = xlContinuous
.ColorIndex = clr
.TintAndShade = 0
.Weight = xlThin
End With
With r.FormatConditions(r.FormatConditions.Count).Borders(xlBottom)
.LineStyle = xlContinuous

.ColorIndex = clr
.TintAndShade = 0
.Weight = xlThin
End With
r.FormatConditions(r.FormatConditions.Count).StopIfTrue = False
End Sub


I also changed your border .Color assignments to .ColorIndex as 10, 11 & 13 seem to be ColorIndex identifiers for *green, blue and purple. The vowels were removed from your variable names to avoid conflict with the names of collection properties.


No comments:

Post a Comment

hard drive - Leaving bad sectors in unformatted partition?

Laptop was acting really weird, and copy and seek times were really slow, so I decided to scan the hard drive surface. I have a couple hundr...