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