copy conditional formats

  • Thread starter Thread starter Bill Roberts
  • Start date Start date
B

Bill Roberts

I have a column that has been conditionally formatted with equations, using
the "fill" command to color the cells based on the relative values of cells
in other columns. I want to copy only the colors to another column, but not
the equations. As if I would do a copy/paste special/values, but the
conditionally formatting equations refuse to go away. I just want only the
color patterns in the new column. Would appreciate any suggestions. TIA
Bill Roberts
 
Bill,

It would require a macro. See below, and run the macro CopyCFFormats,
selecting the ranges as appropriate. As written, the code will transfer
Bold and background color - but you can add as many formatting properties as
your situation requires.


HTH,
Bernie
MS Excel MVP


Sub CopyCFFormats()
Dim R1 As Range
Dim R2 As Range
Dim i As Integer
Dim j As Integer

Dim m As Range
Dim myRet As Variant

Set R1 = Application.InputBox("Select the CF'd range", Type:=8)
Set R2 = Application.InputBox("Select the final range", Type:=8)

If R1.Cells.Count <> R2.Cells.Count Or R1.Rows.Count <> R2.Rows.Count Then
MsgBox "You must select ranges of equal size and shape"
End If
For i = 1 To R1.Rows.Count
For j = 1 To R1.Columns.Count
myRet = CheckFormat(R1.Cells(i, j))
If myRet = False Then GoTo NoCF
If myRet = "None" Then GoTo NoCF
'Copy each desired format, like so:
R2.Cells(i, j).Interior.ColorIndex = _
R1.Cells(i, j).FormatConditions(myRet).Interior.ColorIndex
R2.Cells(i, j).Font.Bold = _
R1.Cells(i, j).FormatConditions(myRet).Font.Bold
NoCF:
Next j
Next i

End Sub


Function CheckFormat(c As Range) As Variant

Dim bCheck As Boolean
Dim i As Integer

If c.FormatConditions.Count = 0 Then
CheckFormat = False
Exit Function
End If

For i = 1 To c.FormatConditions.Count
If c.FormatConditions.Item(i).Type = 1 Then
bCheck = False
Select Case c.FormatConditions.Item(i).Operator
Case 1 ' between
If (c.Value >= CDbl(c.FormatConditions.Item(i).Formula1)) And _
(c.Value <= CDbl(c.FormatConditions.Item(i).Formula2)) Then _
bCheck = True

Case 2 ' not between
If c.Value < CDbl(c.FormatConditions.Item(i).Formula1) Or _
c.Value > CDbl(c.FormatConditions.Item(i).Formula2) Then _
bCheck = True

Case 3 ' equal to
If c.Value = CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 4 ' not equal to
If c.Value <> CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 5 ' greater then
If c.Value > CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 6 ' less then
If c.Value < CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 7 ' greater & equal then
If c.Value >= CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 8 ' less & equal then
If c.Value <= CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

End Select

If bCheck = True Then
CheckFormat = i
bCheck = False
Exit Function
End If
End If
Next i

CheckFormat = "None"

End Function
 
Thank you Bernie. I assumed it would be something like that.
When I try to step through the macro, I get the error message regarding
"CheckFormat(R1.Cells(i,j)".... " Compile error: Sub or Function not
defined". I can't find any references to "CheckFormat". Do I need to write
another function? I am using Excel 2007. Thanks
 
Bernie provided the CheckFormat function in his post.
Function CheckFormat(c As Range) As Variant rest of code
End Function
Click to expand...

Did you copy it and the macro to a general module?


Gord Dibben MS Excel MVP
 
I am really dumb. I saw the "end sub" on Bernie's post and proceeded to copy
everything down through "end sub". Maybe someday I'll learn to use the blue
bar on the right side. Sorry for the unnecessary question.
 
I have tried a lot of options, but I cannot get Bernie’s code to run. I set
up a small spreadsheet: columns A and B have numbers, Column C is
conditionally formatted (Filled) to the relative values in columns A and B,
and the font is Conditionally formatted to bold if the number in Column C is
negative. I have 10 rows. The primary function Compile error (when I try to
run the code attached, hopefully identical to Bernie’s code) is “Case without
Select Caseâ€. There must be something wrong with the statement
“Select Case c.FormatConditions.Item(i).Operatorâ€. I would appreciate any
help or references.
Option Explicit
Dim R1 As Range
Dim R2 As Range
Dim i As Integer
Dim j As Integer
Dim m As Range
Dim myret As Variant
Sub copycfformats()
Set R1 = Application.InputBox("Select the CF'd range", Type:=8)
Set R2 = Application.InputBox("Select the final range", Type:=8)
If R1.Cells.Count <> R2.Cells.Count Or R1.Rows.Count <> R2.Rows.Count Then
MsgBox "You must select ranges of equal size and shape"
End If
For i = 1 To R1.Rows.Count
For j = 1 To R1.Columns.Count
myret = CheckFormat(R1.Cells(i, j))
If myret = False Then GoTo NoCF
If myret = "None" Then GoTo NoCF
R2.Cells(i, j).Interior.colorindex = _
R1.Cells(i, j).FormatConditions(myret).Interior.colorindex
R2.Cells(i, j).Font.Bold = _
R1.Cells(i, j).FormatConditions(myret).Font.Bold
NoCF:
Next j
Next i
End Sub
Function CheckFormat(c As Range) As Variant
Dim bCheck As Boolean
If c.FormatConditions.Count = 0 Then
CheckFormat = False
Exit Function
End If
For i = 1 To c.FormatConditions.Count
If c.FormatConditions.Item(i).Type = 1 Then
bCheck = False
'This command seems to be the compile error
Select Case c.FormatConditions.Item(i).Operator

Case xlBetween
If (c.Value >= CDbl(c.FormatConditions.Item(i).Formula1)) And _
(c.Value <= CDbl(c.FormatConditions.Item(i).Formula2)) Then
bCheck = True

Case xlNotBetween
If c.Value < CDbl(c.FormatConditions.Item(i).Formula1) Or _
c.Value > CDbl(c.FormatConditions.Item(i).Formula2) Then
bCheck = True

Case xlEqual
If c.Value = CDbl(c.FormatConditions.Item(i).Formula1) Then
bCheck = True

Case xlNotEqual
If c.Value <> CDbl(c.FormatConditions.Item(i).Formula1) Then
bCheck = True

Case xlGreater
If c.Value > CDbl(c.FormatConditions.Item(i).Formula1) Then
bCheck = True

Case xlLess
If c.Value < CDbl(c.FormatConditions.Item(i).Formula1) Then
bCheck = True

Case xlGreaterEqual
If c.Value >= CDbl(c.FormatConditions.Item(i).Formula1) Then
bCheck = True

Case xlLessEqual
If c.Value <= CDbl(c.FormatConditions.Item(i).Formula1) Then
bCheck = True
End Select
If bCheck = True Then
CheckFormat = i
bCheck = False
Exit Function
End If
End If
Next i
CheckFormat = "None"
End Function
 
Bill,

Every one of your "Then's" needs to be followed by a space and an
underscore (the continuation character).

For example:

Case xlLess
If c.Value < CDbl(c.FormatConditions.Item(i).Formula1) Then
bCheck = True

Should be

Case xlLess
If c.Value < CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True


Other wise, you could use

Case xlLess
If c.Value < CDbl(c.FormatConditions.Item(i).Formula1) Then
bCheck = True
End If

But you need to do that for every one...

Bernie
 
Thanks very much. That eliminates the “Select Case†error. Now here is what
I get. If I leave the line “If c.FormatConditions.Item(i).Type=1, the code
never gets to the “Select Case†line. It just jumps to the bottom “End Ifâ€.
If I change the line to “c.FormatConditions.Item(i).Type=2â€, then it sets
bcheck=False and when I step through the “Select Case
c.FormatConditions.Item(i).Operatorâ€, I get the error code “Application
defined or object defined errorâ€. I have studied the “Item(i)â€, “.Operatorâ€
and “.Type†Methods, etc. in VBA help, but I can’t figure out what the line
should be. Please help.
 
Bill,

What are the values that the cell can have? What CF are you actually using?

It would help if you select one of the cells with the CF that you want, and start the macro
recorder. Make a minor change to one condition of the CF and then stop the recorder. (You can then
change the CF back.)

Post that code when you are done.

HTH,
Bernie
MS Excel MVP
 
Bernie, I can't do it today, but I will follow your suggestion and post a
reply on Wednesday. Thanks
 
Bernie, here is the code as recorded. I created a macro with the same steps
as I conditionally formatted the column. I did not do it one cell at a time
with a “for….each†statement. Would that be better?? Hope this helps.
Sub Macro1()
Range("C1:C10").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=A1>B1"

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=C1<0"

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
 
Bill,

The code will only work if you are not using the Formula is... option.

HTH,
Bernie
MS Excel MVP
 
Bill,

Below is code that will work with the Formula is.. option. If you are only using Formula Is.. then
you can cut out a lot of the code. Note that the code now must select the cell with the CF to
properly evaluate the formulas, since Excel uses the activecell as the basis for the relative cell
locations in the CF formulas.

HTH,
Bernie
MS Excel MVP

Sub CopyCFFormats()
Dim R1 As Range
Dim R2 As Range
Dim i As Integer
Dim j As Integer
Dim Sel As Range

Set Sel = Selection

Dim m As Range
Dim myRet As Variant

Set R1 = Application.InputBox("Select the CF'd range", Type:=8)
Set R2 = Application.InputBox("Select the final range", Type:=8)

If R1.Cells.Count <> R2.Cells.Count Or R1.Rows.Count <> R2.Rows.Count Then
MsgBox "You must select ranges of equal size and shape"
End If
Application.EnableEvents = False

For i = 1 To R1.Rows.Count
For j = 1 To R1.Columns.Count
R1.Cells(i, j).Select
myRet = CheckFormat(R1.Cells(i, j))
If myRet = False Then GoTo NoCF
If myRet = "None" Then GoTo NoCF
'Copy each desired format, like so:
R2.Cells(i, j).Interior.ColorIndex = _
R1.Cells(i, j).FormatConditions(myRet).Interior.ColorIndex
R2.Cells(i, j).Font.Bold = _
R1.Cells(i, j).FormatConditions(myRet).Font.Bold
NoCF:
Next j
Next i

Sel.Select
Application.EnableEvents = True
End Sub


Function CheckFormat(c As Range) As Variant

Dim bCheck As Boolean
Dim i As Integer

CheckFormat = "None"


If c.FormatConditions.Count = 0 Then
CheckFormat = False
Exit Function
End If

For i = 1 To c.FormatConditions.Count
If c.FormatConditions.Item(i).Type = 1 Then
bCheck = False
Select Case c.FormatConditions.Item(i).Operator
Case 1 ' between
If (c.Value >= CDbl(c.FormatConditions.Item(i).Formula1)) And _
(c.Value <= CDbl(c.FormatConditions.Item(i).Formula2)) Then _
bCheck = True

Case 2 ' not between
If c.Value < CDbl(c.FormatConditions.Item(i).Formula1) Or _
c.Value > CDbl(c.FormatConditions.Item(i).Formula2) Then _
bCheck = True

Case 3 ' equal to
If c.Value = CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 4 ' not equal to
If c.Value <> CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 5 ' greater then
If c.Value > CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 6 ' less then
If c.Value < CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 7 ' greater & equal then
If c.Value >= CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

Case 8 ' less & equal then
If c.Value <= CDbl(c.FormatConditions.Item(i).Formula1) Then _
bCheck = True

End Select

If bCheck = True Then
CheckFormat = i
bCheck = False
Exit Function
End If
End If

If c.FormatConditions.Item(i).Type = 2 Then
bCheck = Application.Evaluate(c.FormatConditions.Item(i).Formula1)
If bCheck Then
CheckFormat = i
bCheck = False
Exit Function
End If
End If
Next i


CheckFormat = "None"

End Function
 
Bernie, I have had some medical issues and I just got back to the macro
today. It looks like it will run OK. I conditionally “format is†some of
the cells (but not all) in column C. When I step through the code, it
formats (fills) every cell in R2, even if the cell in column C does not meet
the format criteria. I think I will be able to work this out. Thank you
very much for the help.
 
Bernie, I still cannot get the macro to work properly. There are 2 rows in
column C. Both cells are conditionally formatted based on the equation
“A1-B1â€. If A>B, then fill the cell yellow. If A1<B1, do not fill any
color. In this case, C1 is yellow (meets the format condition), and C2 is
blank (does not meet the format condition). When I step through the code you
suggested, the command line
bCheck = Application.Evaluate(c.FormatConditions.Item(i).Formula1)
formats both C1 and C2 yellow. It is as if the command line only checks to
see if there is ANY conditional formatting (Type 2 condition), and if there
is, it fills the cell. I am trying to duplicate the fill color (including no
fill), but eliminate the conditional format equations. I have tried running
macros that just get the colorindex, but they don’t work with conditionally
formatted cells. Would appreciate any ideas.
 
Bill,

Did you leave in the line?

R1.Cells(i, j).Select

Excel evaluated CF formulas as if it were copied into the currently selected
cell - so if the selection doesn't change, the formula evaluates to only one
value.

Bernie
 
I thought it might help if I showed you the abridged code:

Option Explicit
Dim R1 As Range
Dim R2 As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Sel As Range
Dim myRet As Variant
Dim bCheck As Boolean
Sub CopyCFFormatsA()
Set Sel = Selection
Set R1 = Range("c1:c10")
Set R2 = Range("d1:d10")
j = 1
Application.EnableEvents = False
For i = 1 To R1.Rows.Count
R1.Cells(i, j).Select
myRet = CheckFormat(R1.Cells(i, j))
If myRet = False Then GoTo NoCF
If myRet = "None" Then GoTo NoCF
R2.Cells(i, j).Interior.colorindex = _
R1.Cells(i, j).FormatConditions(myRet).Interior.colorindex
NoCF:
Next i
Sel.Select
Application.EnableEvents = True
End Sub
Function CheckFormat(c As Range) As Variant
CheckFormat = "None"
For k = 1 To c.FormatConditions.Count
bCheck = Application.Evaluate(c.FormatConditions.Item(k).Formula1)
If bCheck Then
CheckFormat = k
bCheck = False
Exit Function
End If
Next k
CheckFormat = "None"
End Function--
Bill Roberts
 
Bill,

Your version of the code worked perfectly, but I'm testing it in XL 2003. I
will have to try to locate a machine with XL2007 to try it out on, and I
will post back in the morning.

Bernie
 
Back
Top