copy conditional formats

[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

[ebloch]

free ASAP Utilities can do this.

See Format - "Copy and Apply Cell's Formatting Settings

"Bill Roberts" <BillR...@discussions.microsoft.com> wrote in message
news:9FE7CEAD-2ACA-4021...@microsoft.com...

[@consumerdotorg Bernie Deitrick]

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

"Bill Roberts" <BillR...@discussions.microsoft.com> wrote in message
news:9FE7CEAD-2ACA-4021...@microsoft.com...

[Bill Roberts]

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
--
Bill Roberts

"Bernie Deitrick" wrote:

> .
>

[Gord Dibben]

Bernie provided the CheckFormat function in his post.

> Function CheckFormat(c As Range) As Variant

rest of code
>End Function

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

Gord Dibben MS Excel MVP

[Bill Roberts]

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.
--
Bill Roberts

"Bernie Deitrick" wrote:

> .
>

[Bill Roberts]

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 Roberts

[@consumerdotorg Bernie Deitrick]

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

> 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 1 ' between

[Bill Roberts]

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 Roberts

"Bernie Deitrick" wrote:

> .
>

[@consumerdotorg Bernie Deitrick]

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

"Bill Roberts" <BillR...@discussions.microsoft.com> wrote in message

news:79E169C6-0E42-4A76...@microsoft.com...

[Bill Roberts]

Bernie, I can't do it today, but I will follow your suggestion and post a
reply on Wednesday. Thanks
--
Bill Roberts

[Bill Roberts]

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

[@consumerdotorg Bernie Deitrick]

Bill,

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

HTH,
Bernie
MS Excel MVP

"Bill Roberts" <BillR...@discussions.microsoft.com> wrote in message

news:A6169F26-7774-49BF...@microsoft.com...

> 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.

[@consumerdotorg Bernie Deitrick]

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

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 Deitrick" <deitbe @ consumer dot org> wrote in message
news:OIbRQpEd...@TK2MSFTNGP02.phx.gbl...

[Bill Roberts]

Thank you Bernie. I will give it a go, probably on Saturday. Thanks
--
Bill Roberts

"Bernie Deitrick" wrote:

> .
>

[Bill Roberts]

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.

[Bill Roberts]

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 Roberts

[@consumerdotorg Bernie Deitrick]

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

"Bill Roberts" <BillR...@discussions.microsoft.com> wrote in message

news:92681948-D690-4365...@microsoft.com...

[Bill Roberts]

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--

[@consumerdotorg Bernie Deitrick]

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

"Bill Roberts" <BillR...@discussions.microsoft.com> wrote in message

news:751EB0E4-4C64-4699...@microsoft.com...