Make conditional formatting static Make conditional formatting static vba vba

Make conditional formatting static


The following idea was taken from here, although modified to fit some new conditional formatting structures and your needs.

It works like this: Given a workbook with some conditional formatting (make a copy of yours), you put in Sub a() the range of cells you want to transform from conditional to straight formatting, and run the macro. After that, just delete manually the conditional formats, and presto!

Sorry about the code length ... life is sometimes like this :(

Option ExplicitSub a()Dim iconditionno As IntegerDim rng, rgeCell As RangeSet rng = Range("A1:A10")For Each rgeCell In rng   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       End If   End IfNext rgeCellEnd SubPrivate Function ConditionNo(ByVal rgeCell As Range) As IntegerDim iconditionscount As IntegerDim objFormatCondition As FormatCondition    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            If Application.Evaluate(objFormatCondition.Formula1) Then               ConditionNo = iconditionscount               Exit Function            End If       End Select    Next iconditionscountEnd FunctionPrivate 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 SelectEnd Function


I hate it when people say "hey, why aren't you doing that whole thing this other way", but I'll just throw it out there: when I've wanted to do this in the past, I've done it by first copying the entire worksheet in question and then copying and pasting the formulas as values (without moving their location at all). This will freeze the conditional formatting obviously, but also means that recalculating the workbook won't leave you with values that are no longer appropriate for the formatting that's sitting on them.

If this doesn't work, belisarius' code looks great.


This approach seems to work well. I've only implemented it for background colours.

Sub FixColor()    Dim r    For Each r In Selection        r.Interior.Color = r.DisplayFormat.Interior.Color    Next r    Selection.FormatConditions.DeleteEnd Sub