Copy conditional formatting as formatting.

[BrettH]

I want to enable a user to select a command button and have a worksheet copied to a new workbook and saved. My sticking point: the worksheet has conditional formatting that I want to make regular formatting in the new workbook. Something like a Copy -> Paste Values for formats. Any ideas?

Thanks so much,
BrettH

 

[pgc01]

Hi BrettH

There's no default feature that does this automatically.

I wrote this code some time ago to deal with it.

You just have to run CopyWKSNoConditionalFormat().
Make sure you edit the name of the worksheet you want to copy in the first assignment statement:

sWsh = "Sheet4"

Alert: The result is written in a workbook called "NoConditionalFormat" and overwrites the previous result. If you want the alert message boxes, comment the statements

Application.DisplayAlerts = True/False

Option Explicit

' 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.
Sub ConditionalFormatDelink(rRng As Range)
Dim vConditionsSyntax, rCell As Range, rCFormat As Range, iCondition As Integer
Dim sFormula As String, vCSyntax, vOperator

' 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
                    rCell.Font.ColorIndex = .Item(iCondition).Font.ColorIndex
                    rCell.Interior.ColorIndex = .Item(iCondition).Interior.ColorIndex
                    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

Sub CopyWKSNoConditionalFormat()
Dim sWsh As String

sWsh = "Sheet4"

' Duplicates the sheet, keeps all the environment
Worksheets(sWsh).Copy before:=Worksheets(1)

' Delinks conditional formatting
Call ConditionalFormatDelink(ActiveSheet.UsedRange)

' Moves the worksheet to another workbook
ActiveSheet.Move
ActiveSheet.Name = sWsh

' Saves and closes the new workbook, overwrites an existing one
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "NoConditionalFormat"
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

 

[pgc01]

P. S. It only deals with the formats I use the most, which are painting the cells with colours and changing the font colour. This reminds me I have to add the rest.