copy cell color but not conditional format equations

  • Follow


Following is highly abridged code from Bernie Deitrick regarding copying Type 
2 conditional formats.  Column C is formatted yellow if A1>B1, etc.    There 
are 10 rows.  I want to copy the cell color (but not the format equations) to 
column D.  But the line
bCheck = Application.Evaluate(c.FormatConditions.Item(k).Formula1)
always returns Bcheck=True, then myRet is set to 1, and every cell in column 
D is colored (even where the condition is not true).  I think I need another 
IF statement to check if the conditional format is true (and the cell is 
colored), but I can’t get anything to work.  TIA
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
0
Reply Utf 12/8/2009 11:26:01 PM

Bill,

I didn't have time today to find an Excel 2007 machine.  What do you get if 
you add the line

Msgbox c.FormatConditions.Item(k).Formula1
right before the line
bCheck = Application.Evaluate(c.FormatConditions.Item(k).Formula1)

?

Of course, you will get a message for each cell, so only select enough cells 
to see what is going on.

Bernie


"Bill Roberts" <BillRoberts@discussions.microsoft.com> wrote in message 
news:CD02C776-0DC1-45D3-B51E-D92940A163FD@microsoft.com...
> Following is highly abridged code from Bernie Deitrick regarding copying 
> Type
> 2 conditional formats.  Column C is formatted yellow if A1>B1, etc. 
> There
> are 10 rows.  I want to copy the cell color (but not the format equations) 
> to
> column D.  But the line
> bCheck = Application.Evaluate(c.FormatConditions.Item(k).Formula1)
> always returns Bcheck=True, then myRet is set to 1, and every cell in 
> column
> D is colored (even where the condition is not true).  I think I need 
> another
> IF statement to check if the conditional format is true (and the cell is
> colored), but I can’t get anything to work.  TIA
> 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 

0
Reply Bernie 12/9/2009 2:53:12 AM


Great suggestion, Bernie.  The message box always returns "=A1>B1", 
regardless of the cell, so although the conditional formatting does not color 
some cells (condition not true), the macro only and always looks at the 
condition of the first cell.  I am only working with 10 cells so stepping is 
not a big problem.
I didn't think about the message box as a diagnostic tool.  I will work on 
this some more but would very much appreciate your thoughts. 
-- 
Bill Roberts


"Bernie Deitrick" wrote:

> Bill,
> 
> I didn't have time today to find an Excel 2007 machine.  What do you get if 
> you add the line
> 
> Msgbox c.FormatConditions.Item(k).Formula1
> right before the line
> bCheck = Application.Evaluate(c.FormatConditions.Item(k).Formula1)
> 
> ?
> 
> Of course, you will get a message for each cell, so only select enough cells 
> to see what is going on.
> 
> Bernie
> 
> 
> "Bill Roberts" <BillRoberts@discussions.microsoft.com> wrote in message 
> news:CD02C776-0DC1-45D3-B51E-D92940A163FD@microsoft.com...
> > Following is highly abridged code from Bernie Deitrick regarding copying 
> > Type
> > 2 conditional formats.  Column C is formatted yellow if A1>B1, etc. 
> > There
> > are 10 rows.  I want to copy the cell color (but not the format equations) 
> > to
> > column D.  But the line
> > bCheck = Application.Evaluate(c.FormatConditions.Item(k).Formula1)
> > always returns Bcheck=True, then myRet is set to 1, and every cell in 
> > column
> > D is colored (even where the condition is not true).  I think I need 
> > another
> > IF statement to check if the conditional format is true (and the cell is
> > colored), but I can’t get anything to work.  TIA
> > 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 
> 
> .
> 
0
Reply Utf 12/11/2009 12:35:48 AM

2 Replies
743 Views

(page loaded in 2.286 seconds)

Similiar Articles:













8/21/2012 6:57:35 AM


Reply: