I have been trying to work out how to remove the conditional formatting
(CF) from some cells but not the effects of that formatting ie if the
CF sets the shading to grey, I need to remove the CF but leave the cell
shaded grey. I have learnt that this seems to be only possible via the
use of macro's. I have found one such macro that I have copied, however
when I run it within my spreadsheet I get a Run Time Error '13'

Here's the code:


Code:
--------------------

--------------------
Option Explicit
Sub PasteFC()
Application.ScreenUpdating = False
Dim rWhole As Range
Dim rCell As Range
Dim ndx As Integer
Dim FCFont As Font
Dim FCBorder As Border
Dim FCInt As Interior
Dim x As Integer
Dim iBorders(3) As Integer

iBorders(0) = xlLeft
iBorders(1) = xlRight
iBorders(2) = xlTop
iBorders(3) = xlBottom

Set rWhole = Selection

For Each rCell In rWhole
rCell.Select
ndx = ActiveCondition(rCell)
If ndx < 0 Then
'Change the Font info
Set FCFont = rCell.FormatConditions(ndx).Font
With rCell.Font
Bold = NewFC(.Bold, FCFont.Bold)
Italic = NewFC(.Italic, FCFont.Italic)
Underline = NewFC(.Underline, FCFont.Underline)
Strikethrough = NewFC(.Strikethrough, _
FCFont.Strikethrough)
ColorIndex = NewFC(.ColorIndex, FCFont.ColorIndex)
End With
'Change the Border Info for each of the 4 types
For x = 0 To 3
Set FCBorder =
rCell.FormatConditions(ndx).Borders(iBorders(x))
With rCell.Borders(iBorders(x))
LineStyle = NewFC(.LineStyle, FCBorder.LineStyle)
Weight = NewFC(.Weight, FCBorder.Weight)
ColorIndex = NewFC(.ColorIndex,
FCBorder.ColorIndex)
End With
Next x
'Change the interior info
Set FCInt = rCell.FormatConditions(ndx).Interior
With rCell.Interior
ColorIndex = NewFC(.ColorIndex, FCInt.ColorIndex)
Pattern = NewFC(.Pattern, FCInt.Pattern)
End With
'Delete FC
rCell.FormatConditions.Delete
End If
Next
rWhole.Select
Application.ScreenUpdating = True
MsgBox ("The Formatting based on the Conditions" & vbCrLf & _
"in the range " & rWhole.Address & vbCrLf & _
"has been made standard for those cells" & vbCrLf & _
"and the Conditional Formatting has been removed")
End Sub

Function NewFC(vCurrent As Variant, vNew As Variant)
If IsNull(vNew) Then
NewFC = vCurrent
Else
NewFC = vNew
End If
End Function

Function ActiveCondition(rng As Range) As Integer
'Chip Pearson http://www.cpearson.com/excel/CFColors.htm
Dim ndx As Long
Dim FC As FormatCondition

If rng.FormatConditions.Count = 0 Then
ActiveCondition = 0
Else
For ndx = 1 To rng.FormatConditions.Count
Set FC = rng.FormatConditions(ndx)
Select Case FC.Type
Case xlCellValue
Select Case FC.Operator
Case xlBetween
If CDbl(rng.Value) = CDbl(FC.Formula1) And _
CDbl(rng.Value) <= CDbl(FC.Formula2) Then
ActiveCondition = ndx
Exit Function
End If
Case xlGreater
If CDbl(rng.Value) CDbl(FC.Formula1) Then
ActiveCondition = ndx
Exit Function
End If
Case xlEqual
If CDbl(rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = ndx
Exit Function
End If
Case xlGreaterEqual
If CDbl(rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = ndx
Exit Function
End If
Case xlLess
If CDbl(rng.Value) < CDbl(FC.Formula1) Then
ActiveCondition = ndx
Exit Function
End If
Case xlLessEqual
If CDbl(rng.Value) <= CDbl(FC.Formula1) Then
ActiveCondition = ndx
Exit Function
End If
Case xlNotEqual
If CDbl(rng.Value) < CDbl(FC.Formula1) Then
ActiveCondition = ndx
Exit Function
End If
Case xlNotBetween
If CDbl(rng.Value) <= CDbl(FC.Formula1) Or _
CDbl(rng.Value) = CDbl(FC.Formula2) Then
ActiveCondition = ndx
Exit Function
End If
Case Else
Debug.Print "UNKNOWN OPERATOR"
End Select
Case xlExpression
If Application.Evaluate(FC.Formula1) Then
ActiveCondition = ndx
Exit Function
End If
Case Else
Debug.Print "UNKNOWN TYPE"
End Select
Next ndx
End If
ActiveCondition = 0
End Function
Code:
--------------------

--------------------



I get the error at the line
If CDbl(rng.Value) = CDbl(FC.Formula1) Then
within the ActiveCondition Function

Is anyone able to help me work out why I am getting this error?

Thanks

Karen


--
ksp
------------------------------------------------------------------------
ksp's Profile: http://www.excelforum.com/member.php...fo&userid=6267
View this thread: http://www.excelforum.com/showthread...hreadid=560148