Hi again
As I told you by PM the code was, in fact, only dealing with Background Colour and Font Colour, those are the ones I usually use.
Since you are also using Borders in your Conditional formatting, this was a good ocasion to add them. I took the opportunity to also add the rest: Font Style, Underline and Strikethrough.
...
' PGC Nov 06
' Delinks formats from conditions in cells with conditional formatting.
' The cells keep the format that was enabled with the conditional formatting
' but as normal format. Background and Font Colour
' Oct 07
' Added Borders, Font Style, Underline and Strikethrough
' Patejl Feb 12
' Fixed Excel 2007 compatibility issues
Sub ConditionalFormatDelink(rRng As Range)
Dim vConditionsSyntax, rCell As Range, rCFormat As Range, iCondition As Integer
Dim sFormula As String, vCSyntax, vOperator, iBorder As Integer, vBorders
Dim firstRow As Long, firstColumn As Long, firstCell As Range, conditionArea As Range
vBorders = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom)
' Syntax for "Value is" Conditions
vConditionsSyntax = Array( _
Array(xlEqual, "CellRef = Condition1"), _
Array(xlNotEqual, "CellRef <> Condition1"), _
Array(xlLess, "CellRef < Condition1"), _
Array(xlLessEqual, "CellRef <= Condition1"), _
Array(xlGreater, "CellRef > Condition1"), _
Array(xlGreaterEqual, "CellRef >= Condition1"), _
Array(xlBetween, "AND(CellRef >= Condition1, CellRef <= Condition2)"), _
Array(xlNotBetween, "OR(CellRef < Condition1, CellRef > Condition2)") _
)
' Get cells with format
On Error GoTo EndSub
Set rCFormat = rRng.SpecialCells(xlCellTypeAllFormatConditions)
On Error Resume Next
For Each rCell In rCFormat ' Loops through all the cells with conditional formatting
If Not IsError(rCell) Then ' skips cells with error
rCell.Activate
With rCell.FormatConditions
For iCondition = 1 To .Count ' loops through all the conditions
'Locate the first cell in the AppliesTo area (used as a reference for sFormula)
firstRow = .Item(iCondition).AppliesTo.Row
firstColumn = .Item(iCondition).AppliesTo.Column
If .Item(iCondition).AppliesTo.Areas.Count > 1 Then
For Each conditionArea In .Item(iCondition).AppliesTo.Areas
If conditionArea.Row < firstRow Then firstRow = conditionArea.Row
If conditionArea.Column < firstColumn Then firstColumn = conditionArea.Column
Next conditionArea
End If
Set firstCell = Cells(firstRow, firstColumn)
sFormula = .Item(iCondition).Formula1
Err.Clear
vOperator = .Item(iCondition).Operator
If Err <> 0 Then ' "Formula Is"
Err.Clear
Else ' "Value Is"
For Each vCSyntax In vConditionsSyntax ' checks all the condition types
If .Item(iCondition).Operator = vCSyntax(0) Then
' build the formula equivalent to the condition
sFormula = Replace(vCSyntax(1), "Condition1", Evaluate(sFormula))
sFormula = Replace(sFormula, "CellRef", rCell.Address)
sFormula = Replace(sFormula, "Condition2", Evaluate(.Item(iCondition).Formula2))
Exit For
End If
Next vCSyntax
End If
'Uncomment when needed: Fix formula (Czech list separator -> US list separator)
'sFormula = Replace(sFormula, ",", ".")
'sFormula = Replace(sFormula, ";", ",")
'Shift formula (relate it to the first cell of the AppliesTo area)
sFormula = Application.ConvertFormula(Formula:=sFormula, fromReferenceStyle:=xlA1, toReferenceStyle:=xlR1C1, RelativeTo:=firstCell)
sFormula = Application.ConvertFormula(Formula:=sFormula, fromReferenceStyle:=xlR1C1, toReferenceStyle:=xlA1, RelativeTo:=rCell)
If Evaluate(sFormula) Then
' The cell has a condition = True. Delink the format from the conditional formatting
' Background
If Not IsNull(.Item(iCondition).Interior.ColorIndex) Then _
rCell.Interior.Color = .Item(iCondition).Interior.Color
' Font
If Not IsNull(.Item(iCondition).Font.ColorIndex) Then _
rCell.Font.Color = .Item(iCondition).Font.Color
If Not IsNull(.Item(iCondition).Font.FontStyle) Then _
rCell.Font.FontStyle = .Item(iCondition).Font.FontStyle
If Not IsNull(.Item(iCondition).Font.Strikethrough) Then _
rCell.Font.Strikethrough = .Item(iCondition).Font.Strikethrough
If Not IsNull(.Item(iCondition).Font.Underline) Then _
rCell.Font.Underline = .Item(iCondition).Font.Underline
' Borders
With .Item(iCondition)
For iBorder = 1 To 4
If .Borders(iBorder).LineStyle <> xlNone Then
rCell.Borders(vBorders(iBorder - 1)).LineStyle = .Borders(iBorder).LineStyle
rCell.Borders(vBorders(iBorder - 1)).ColorIndex = .Borders(iBorder).ColorIndex
rCell.Borders(vBorders(iBorder - 1)).Weight = .Borders(iBorder).Weight
End If
Next iBorder
End With
'Exit on StopIfTrue
If .Item(iCondition).StopIfTrue Then Exit For
End If
Next iCondition
End With
End If
rCell.FormatConditions.Delete ' deletes the cell's conditional formatting
Next rCell
EndSub:
End Sub
Sub ConditionalFormatDelink(rRng As Range)
Dim vConditionsSyntax, rCell As Range, rCFormat As Range, iCondition As Integer
Dim sFormula As String, vCSyntax, vOperator, iBorder As Integer, vBorders
Dim firstRow As Long, firstColumn As Long, firstCell As Range, conditionArea As Range
vBorders = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom)
' Syntax for "Value is" Conditions
vConditionsSyntax = Array( _
Array(xlEqual, "CellRef = Condition1"), _
Array(xlNotEqual, "CellRef <> Condition1"), _
Array(xlLess, "CellRef < Condition1"), _
Array(xlLessEqual, "CellRef <= Condition1"), _
Array(xlGreater, "CellRef > Condition1"), _
Array(xlGreaterEqual, "CellRef >= Condition1"), _
Array(xlBetween, "AND(CellRef >= Condition1, CellRef <= Condition2)"), _
Array(xlNotBetween, "OR(CellRef < Condition1, CellRef > Condition2)") _
)
' Get cells with format
On Error GoTo EndSub
Set rCFormat = rRng.SpecialCells(xlCellTypeAllFormatConditions)
On Error Resume Next
For Each rCell In rCFormat ' Loops through all the cells with conditional formatting
If Not IsError(rCell) Then ' skips cells with error
rCell.Activate
With rCell.FormatConditions
For iCondition = 1 To .Count ' loops through all the conditions
'Locate the first cell in the AppliesTo area (used as a reference for sFormula)
firstRow = .Item(iCondition).AppliesTo.Row
firstColumn = .Item(iCondition).AppliesTo.Column
If .Item(iCondition).AppliesTo.Areas.Count > 1 Then
For Each conditionArea In .Item(iCondition).AppliesTo.Areas
If conditionArea.Row < firstRow Then firstRow = conditionArea.Row
If conditionArea.Column < firstColumn Then firstColumn = conditionArea.Column
Next conditionArea
End If
Set firstCell = Cells(firstRow, firstColumn)
sFormula = .Item(iCondition).Formula1
Err.Clear
vOperator = .Item(iCondition).Operator
If Err <> 0 Then ' "Formula Is"
Err.Clear
Else ' "Value Is"
For Each vCSyntax In vConditionsSyntax ' checks all the condition types
If .Item(iCondition).Operator = vCSyntax(0) Then
' build the formula equivalent to the condition
sFormula = Replace(vCSyntax(1), "Condition1", Evaluate(sFormula))
sFormula = Replace(sFormula, "CellRef", rCell.Address)
sFormula = Replace(sFormula, "Condition2", Evaluate(.Item(iCondition).Formula2))
Exit For
End If
Next vCSyntax
End If
'Shift formula (relate it to the first cell of the AppliesTo area)
sFormula = Application.ConvertFormula(Formula:=sFormula, fromReferenceStyle:=xlA1, toReferenceStyle:=xlR1C1, RelativeTo:=firstCell)
sFormula = Application.ConvertFormula(Formula:=sFormula, fromReferenceStyle:=xlR1C1, toReferenceStyle:=xlA1, RelativeTo:=rCell)
If Evaluate(sFormula) Then
' The cell has a condition = True. Delink the format from the conditional formatting
' Background
If Not IsNull(.Item(iCondition).Interior.ColorIndex) Then _
rCell.Interior.Color = .Item(iCondition).Interior.Color
'Exit on StopIfTrue
If .Item(iCondition).StopIfTrue Then Exit For
End If
Next iCondition
End With
End If
rCell.FormatConditions.Delete ' deletes the cell's conditional formatting
Next rCell
EndSub:
End Sub
Hi, this was just what I was looking for as well. It works great for condition 1, but it "erases" condition 2. My condition 1 was made permanent as desired, but my conditions 2 just went away.
Code:'Menu items (with their set of Rights) that did not exist on the last report are highlighted in YELLOW (6) Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AA2=""""" With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ColorIndex = 6 .TintAndShade = 0 End With 'Rights that have changed from last report are highlighted in RED (3) Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AA2<>E2" With Selection.FormatConditions(2).Interior .PatternColorIndex = xlAutomatic .ColorIndex = 3 End With
Please advise. Thank you.
Sub ConditionalFormatDelink(rRng As Range)
' Converts conditional formating to actual formatting of the cells specified
' Call E.g. Call ConditionalFormatDelink(Range("J3:IJ3"))
' PGC Nov 06
' Delinks formats from conditions in cells with conditional formatting.
' The cells keep the format that was enabled with the conditional formatting
' but as normal format. Background and Font Colour
' Oct 07
' Added Borders, Font Style, Underline and Strikethrough
' Apr 16
' Add check of 'Stop If True' condition
Dim vConditionsSyntax, rCell As Range, rCFormat As Range, iCondition As Integer
Dim sFormula As String, vCSyntax, vOperator, iBorder As Integer, vBorders
vBorders = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom)
' Syntax for "Value is" Conditions
vConditionsSyntax = Array( _
Array(xlEqual, "CellRef = Condition1"), _
Array(xlNotEqual, "CellRef <> Condition1"), _
Array(xlLess, "CellRef < Condition1"), _
Array(xlLessEqual, "CellRef <= Condition1"), _
Array(xlGreater, "CellRef > Condition1"), _
Array(xlGreaterEqual, "CellRef >= Condition1"), _
Array(xlBetween, "AND(CellRef >= Condition1, CellRef <= Condition2)"), _
Array(xlNotBetween, "OR(CellRef < Condition1, CellRef > Condition2)") _
)
' Get cells with format
On Error GoTo EndSub
Set rCFormat = rRng.SpecialCells(xlCellTypeAllFormatConditions)
On Error Resume Next
For Each rCell In rCFormat ' Loops through all the cells with conditional formatting
If Not IsError(rCell) Then ' skips cells with error
rCell.Activate
With rCell.FormatConditions
For iCondition = 1 To .Count ' loops through all the conditions
sFormula = .Item(iCondition).Formula1
Err.Clear
vOperator = .Item(iCondition).Operator
If Err <> 0 Then ' "Formula Is"
Err.Clear
Else ' "Value Is"
For Each vCSyntax In vConditionsSyntax ' checks all the condition types
If .Item(iCondition).Operator = vCSyntax(0) Then
' build the formula equivalent to the condition
sFormula = Replace(vCSyntax(1), "Condition1", sFormula)
sFormula = Replace(sFormula, "CellRef", rCell.Address)
sFormula = Replace(sFormula, "Condition2", .Item(iCondition).Formula2)
Exit For
End If
Next vCSyntax
End If
If Evaluate(sFormula) Then
' The cell has a condition = True. Delink the format from the conditional formatting
' Background - If a colour is specified and it's not 'No Colour'
If Not IsNull(.Item(iCondition).Interior.ColorIndex) Then
If .Item(iCondition).Interior.ColorIndex <> -4142 Then _
rCell.Interior.ColorIndex = .Item(iCondition).Interior.ColorIndex
End If
' Font
If Not IsNull(.Item(iCondition).Font.ColorIndex) Then
If .Item(iCondition).Interior.ColorIndex <> -4142 Then _
rCell.Font.ColorIndex = .Item(iCondition).Font.ColorIndex
End If
If Not IsNull(.Item(iCondition).Font.FontStyle) Then _
rCell.Font.FontStyle = .Item(iCondition).Font.FontStyle
If Not IsNull(.Item(iCondition).Font.Strikethrough) Then _
rCell.Font.Strikethrough = .Item(iCondition).Font.Strikethrough
If Not IsNull(.Item(iCondition).Font.Underline) Then _
rCell.Font.Underline = .Item(iCondition).Font.Underline
' Borders
With .Item(iCondition)
For iBorder = 1 To 4
If .Borders(iBorder).LineStyle <> xlNone Then
rCell.Borders(vBorders(iBorder - 1)).LineStyle = .Borders(iBorder).LineStyle
rCell.Borders(vBorders(iBorder - 1)).ColorIndex = .Borders(iBorder).ColorIndex
rCell.Borders(vBorders(iBorder - 1)).Weight = .Borders(iBorder).Weight
End If
Next iBorder
End With
If .Item(iCondition).StopIfTrue Then
Exit For ' if one condition is true skips the next ones
End If
End If
Next iCondition
End With
End If
rCell.FormatConditions.Delete ' deletes the cell's conditional formatting
Next rCell
EndSub:
End Sub
Very nice solution. Thanks a lot for the VBA solution.Hi again
As I told you by PM the code was, in fact, only dealing with Background Colour and Font Colour, those are the ones I usually use.
Since you are also using Borders in your Conditional formatting, this was a good ocasion to add them. I took the opportunity to also add the rest: Font Style, Underline and Strikethrough.
Try:
Code:' PGC Nov 06 ' Delinks formats from conditions in cells with conditional formatting. ' The cells keep the format that was enabled with the conditional formatting ' but as normal format. Background and Font Colour ' Oct 07 ' Added Borders, Font Style, Underline and Strikethrough Sub ConditionalFormatDelink(rRng As Range) Dim vConditionsSyntax, rCell As Range, rCFormat As Range, iCondition As Integer Dim sFormula As String, vCSyntax, vOperator, iBorder As Integer, vBorders vBorders = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom) ' Syntax for "Value is" Conditions vConditionsSyntax = Array( _ Array(xlEqual, "CellRef = Condition1"), _ Array(xlNotEqual, "CellRef <> Condition1"), _ Array(xlLess, "CellRef < Condition1"), _ Array(xlLessEqual, "CellRef <= Condition1"), _ Array(xlGreater, "CellRef > Condition1"), _ Array(xlGreaterEqual, "CellRef >= Condition1"), _ Array(xlBetween, "AND(CellRef >= Condition1, CellRef <= Condition2)"), _ Array(xlNotBetween, "OR(CellRef < Condition1, CellRef > Condition2)") _ ) ' Get cells with format On Error GoTo EndSub Set rCFormat = rRng.SpecialCells(xlCellTypeAllFormatConditions) On Error Resume Next For Each rCell In rCFormat ' Loops through all the cells with conditional formatting If Not IsError(rCell) Then ' skips cells with error rCell.Activate With rCell.FormatConditions For iCondition = 1 To .Count ' loops through all the conditions sFormula = .Item(iCondition).Formula1 Err.Clear vOperator = .Item(iCondition).Operator If Err <> 0 Then ' "Formula Is" Err.Clear Else ' "Value Is" For Each vCSyntax In vConditionsSyntax ' checks all the condition types If .Item(iCondition).Operator = vCSyntax(0) Then ' build the formula equivalent to the condition sFormula = Replace(vCSyntax(1), "Condition1", sFormula) sFormula = Replace(sFormula, "CellRef", rCell.Address) sFormula = Replace(sFormula, "Condition2", .Item(iCondition).Formula2) Exit For End If Next vCSyntax End If If Evaluate(sFormula) Then ' The cell has a condition = True. Delink the format from the conditional formatting ' Background If Not IsNull(.Item(iCondition).Interior.ColorIndex) Then _ rCell.Interior.ColorIndex = .Item(iCondition).Interior.ColorIndex ' Font If Not IsNull(.Item(iCondition).Font.ColorIndex) Then _ rCell.Font.ColorIndex = .Item(iCondition).Font.ColorIndex If Not IsNull(.Item(iCondition).Font.FontStyle) Then _ rCell.Font.FontStyle = .Item(iCondition).Font.FontStyle If Not IsNull(.Item(iCondition).Font.Strikethrough) Then _ rCell.Font.Strikethrough = .Item(iCondition).Font.Strikethrough If Not IsNull(.Item(iCondition).Font.Underline) Then _ rCell.Font.Underline = .Item(iCondition).Font.Underline ' Borders With .Item(iCondition) For iBorder = 1 To 4 If .Borders(iBorder).LineStyle <> xlNone Then rCell.Borders(vBorders(iBorder - 1)).LineStyle = .Borders(iBorder).LineStyle rCell.Borders(vBorders(iBorder - 1)).ColorIndex = .Borders(iBorder).ColorIndex rCell.Borders(vBorders(iBorder - 1)).Weight = .Borders(iBorder).Weight End If Next iBorder End With Exit For ' if one condition is true skips the next ones End If Next iCondition End With End If rCell.FormatConditions.Delete ' deletes the cell's conditional formatting Next rCell EndSub: End Sub
Call it with (don't forget to ajust the range):
Code:Sub BreakCF() Call ConditionalFormatDelink(Range("J3:IJ3")) End Sub
Run the code in the active sheet.