I'm trying to make a macro in VBA Excel to apply a few conditional formats.
See below:
Private Sub CommandButton1_Click()
'Delete conditional formats
Sheets("Results").Cells.FormatConditions.Delete
'Red formats
Sheets("Results").Select
With ActiveSheet.Range("C:C,A:A")
.FormatConditions.AddUniqueValues
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).DupeUnique = xlDuplicate
End With
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
'Blue formats
With ActiveSheet.Range("E:E,C:C,A:A")
.FormatConditions.AddUniqueValues
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).DupeUnique = xlUnique
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
The error pops up in these lines of code:
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Sometimes it works sometimes it doesn't.
I recorded this macro and was working fine few days ago.
Related
I have recorded a macro that corrects the conditional formatting rules of a table every time they get messed up (because of adding or removing lines I suppose…)
And I put a button to activate the macro in the sheet
I need to replicate the same table in several sheets (increasing number of sheets) and I want my macro to function on all of them (not necessarily simultaneously) in addition of having this common table, most of the sheets have other tables also, but there will be 1 table that will be replicated in MOST sheets.
(Basically create a template sheet containing the table and macro button that users will replicate for each new client
Since the tables will have same number of columns and column titles, is it possible to tweak it so it works on any table where the cursor has selected a cell? Or similar?
Maybe some way of changing the ref from “bookingInfo” to “selected table”
FYI: I do not know how to write VBA at all
Here is the code I have:
Application.ScreenUpdating = False
Application.Goto Reference:="BookingInfo"
Selection.ListObject.Range.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$B4<>$B5"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$A5<>"""""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Pattern = xlLightDown
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$AN5=""Full PMT"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$AN5=""Partial PMT"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
End Sub
Any Help?
You could do it like this:
Sub CFUpdate()
Dim lo As ListObject, rng As Range
Set lo = Selection.ListObject
If lo Is Nothing Then 'is the selection in a listobject?
MsgBox "First select any cell in the Table to be updated", vbExclamation
Exit Sub 'nothing to do...
End If
Set rng = lo.DataBodyRange 'range to be formatted
rng.FormatConditions.Delete
With AddFC(rng, xlExpression, "=$B4<>$B5").Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With AddFC(rng, xlExpression, "=$A5<>""""").Interior
.Pattern = xlLightDown
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
With AddFC(rng, xlExpression, "=$AN5=""Full PMT""").Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399945066682943
End With
With AddFC(rng, xlExpression, "=$AN5=""Partial PMT""").Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399945066682943
End With
Application.ScreenUpdating = True
End Sub
'factoring out some common steps
Function AddFC(rng As Range, fcType As XlFormatConditionType, frmla As String)
Dim fc As FormatCondition
Set fc = rng.FormatConditions.Add(Type:=fcType, Formula1:=frmla)
fc.StopIfTrue = False
Set AddFC = fc 'return the FormatCondition we just added
End Function
Pulled some of the common code out into a separate function to reduce the bulk of the code when adding each format condition.
Note you'll also need to adjust the formulas if the tables don't all start on the same row...
I want the run an IF/ELSE statement across the range of cells selected by the user.
Currently which ever IF/ELSE statement is true for the first cell in the selection, is then applying to all the cells in the section rather than doing a for each loop.
Sub MultiCellTest()
With Selection
If ActiveCell > 10 Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6684927
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764159
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End With
End Sub
Thanks.
Here is how you would modify your code to handle each cell in the active selection.
Sub MultiCellTest()
For Each cell in Selection
If cell > 10 Then
With cell.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6684927
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
With cell.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16764159
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
End Sub
As i wanted to conditional formatting of colour scale in the range as shown below, i recorded the macro while doing it. The code will work but i encountered the "procedure is large error"(compile error) when i do the same thing for 36 pivottables. So is there a way to decrease the size of the procedure so that i can do it for 60 pivotables?
The type of conditional formatting that i used for my colour scale
Sub test()
Range("B5:J12").Select
Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValuePercentile
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 8711167
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
xlConditionValueHighestValue
With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
Selection.FormatConditions(1).ScopeType = xlSelectionScope
End Sub
Error message
You need to extract the formatting code into a separate sub, and call it from the main code - no need to repeat virtually the same lines over and over.
For example:
Sub Main()
ApplyFC Worksheets("Sheet1").Range("B5:J12")
ApplyFC Worksheets("Sheet2").Range("B5:J12")
'etc etc
End Sub
Sub ApplyFC(rng As Range)
With rng.FormatConditions.AddColorScale(ColorScaleType:=3)
.SetFirstPriority
.ColorScaleCriteria(1).Type = xlConditionValueLowestValue
With .ColorScaleCriteria(1).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
.ColorScaleCriteria(2).Type = xlConditionValuePercentile
.ColorScaleCriteria(2).Value = 50
With .ColorScaleCriteria(2).FormatColor
.Color = 8711167
.TintAndShade = 0
End With
.ColorScaleCriteria(3).Type = xlConditionValueHighestValue
With .ColorScaleCriteria(3).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
.ScopeType = xlSelectionScope
End With
End Sub
I'm trying to turn any cell that matches a preset value to a color.
If cells values are:
S-DAYS, C-DAYS, DAYS it will turn the cell BLUE with black text
E SWING, S-E SWING, C-E SWING it will turn Green with black text
L SWING, S-L SWING, C-L SWING it will turn Light Purple with black text
LATES, S-LATES, C-LATES it will turn Gray with black text
AOT will turn Yellow with black text
VAC, OUT, MIL, TRAIN it will turn the cell BLACK with White Text
I recorded the following. How do I to make it apply automatically to the sheet without needing to be prompted?
Sub DAConditionalFormating()
'
' DAConditionalFormating Macro
'
'
Range("D14:XFD999").Select
Selection.FormatConditions.Add Type:=xlTextString, String:="DAYS", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlTextString, String:="E SWING", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlTextString, String:="LATES", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249946592608417
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlTextString, String:="VAC", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
Applying conditional formatting to a whole sheet is a really, really bad idea. The calculation will kick in every time you edit ANY cell in sheet.
Instead of conditional formatting the whole sheet, use code to format only the cell that was just changed. Format the cell fill and the font.
Run this code in a Worksheet_Change event in the Sheet module and let it work on the target cell. Then it will run fast and change only the cell that was just changed.
Something like this. Add more ElseIF as required. The code goes into the Sheet module of the sheet.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "foo" Then
With Target.Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
End With
ElseIf Target.Value = "bar" Then
With Target.Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
End If
End Sub
I have a macro which applies conditional formatting to a row which highlights specific values
I was wondering if there was a way to apply it to multiple rows (I want it to run from rows 18-79)
As you can see from my code below, the function has to be adjusted for each row individually (I have done 3).
I was wondering if there was an easier way to apply this rather than repeat and adjust for all the rows I need.
Sub Highlight()
'
' Highlight good values
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Rows("18:18").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=$C$18", Formula2:="=$D$18"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Rows("19:19").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=$C$19", Formula2:="=$D$19"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Rows("20:20").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=$C$20", Formula2:="=$D$20"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Next ws
Application.ScreenUpdating = True
End Sub
change the range to include it all:
With ActiveSheet.Rows("18:79")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=$C18", Formula2:="=$D18"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With