I've put together Belisarius and Cameron Forward's addition. You have to select the area you would like to freeze (large selections might take a while). I've noticed if there are excel errors on cells it might cause an exception, but otherwise this is working great on Excel 2010. By the way, thank you all!
Option Explicit
Sub FreezeConditionalFormattingOnSelection()
Call FreezeConditionalFormatting(Selection)
Selection.FormatConditions.Delete
End Sub
Public Function FreezeConditionalFormatting(Rng As Range)
Rem Originally posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static
Rem Modified 2012-04-20 by gcl to:
Rem (a) be a function taking target range as an argument, and
Rem (b) to cancel any multiple selection before processing in order to work around a bug
Rem in Excel 2003 wherein querying the formula on any cell in a multiple/extended selection
Rem returns the conditional formatting on the first cell in that selection!
Rem (c) return number of cells that it modified.
Dim iconditionno As Integer
Dim rgeCell As Range
Dim nCFCells As Integer
Dim rgeOldSelection As Range
Set rgeOldSelection = Selection 'new
nCFCells = 0
For Each rgeCell In Rng
rgeCell.Select 'new
If rgeCell.FormatConditions.Count <> 0 Then
iconditionno = ConditionNo(rgeCell)
If iconditionno <> 0 Then
rgeCell.Interior.ColorIndex = rgeCell.FormatConditions(iconditionno).Interior.ColorIndex
rgeCell.Font.ColorIndex = rgeCell.FormatConditions(iconditionno).Font.ColorIndex
nCFCells = nCFCells + 1
End If
End If
Next rgeCell
rgeOldSelection.Select 'new
FreezeConditionalFormatting = nCFCells
End Function
Private Function ConditionNo(ByVal rgeCell As Range) As Integer
Rem posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static
Dim iconditionscount As Integer
Dim objFormatCondition As FormatCondition
Dim f3 As String
For iconditionscount = 1 To rgeCell.FormatConditions.Count
Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)
Select Case objFormatCondition.Type
Case xlCellValue
Select Case objFormatCondition.Operator
Case xlBetween: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True And _
Compare(rgeCell.Value, "<=", objFormatCondition.Formula2) = True Then _
ConditionNo = iconditionscount
Case xlNotBetween: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True And _
Compare(rgeCell.Value, ">=", objFormatCondition.Formula2) = True Then _
ConditionNo = iconditionscount
Case xlGreater: If Compare(rgeCell.Value, ">", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount
Case xlEqual: If Compare(rgeCell.Value, "=", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount
Case xlGreaterEqual: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount
Case xlLess: If Compare(rgeCell.Value, "<", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount
Case xlLessEqual: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount
Case xlNotEqual: If Compare(rgeCell.Value, "<>", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount
If ConditionNo > 0 Then Exit Function
End Select
Case xlExpression
f3 = objFormatCondition.Formula1
f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlA1, ToReferenceStyle:=xlR1C1, RelativeTo:=objFormatCondition.AppliesTo.Cells(1, 1))
f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlR1C1, ToAbsolute:=xlAbsolute, RelativeTo:=rgeCell)
f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlA1)
If Application.Evaluate(f3) Then
ConditionNo = iconditionscount
Exit Function
End If
End Select
Next iconditionscount
End Function
Private Function Compare(ByVal vValue1 As Variant, _
ByVal sOperator As String, _
ByVal vValue2 As Variant) As Boolean
If Left(CStr(vValue1), 1) = "=" Then vValue1 = Application.Evaluate(vValue1)
If Left(CStr(vValue2), 1) = "=" Then vValue2 = Application.Evaluate(vValue2)
If IsNumeric(vValue1) = True Then vValue1 = CDbl(vValue1)
If IsNumeric(vValue2) = True Then vValue2 = CDbl(vValue2)
Select Case sOperator
Case "=": Compare = (vValue1 = vValue2)
Case "<": Compare = (vValue1 < vValue2)
Case "<=": Compare = (vValue1 <= vValue2)
Case ">": Compare = (vValue1 > vValue2)
Case ">=": Compare = (vValue1 >= vValue2)
Case "<>": Compare = (vValue1 <> vValue2)
End Select
End Function