Macro to Delete Conditionally Formatted Cells

**luckylindy345** · 10-15-2008, 07:09 AM

The following macro goes throughout a sheet in a workbook and finds highlighted cells. When it finds a highlighted cell it clears the contents of that cell. It works well IF the highlighted cell is highlighted manually. However, I often use worksheets with conditional formatting that automatically finds cells with "bad" data and highlights them. The macro won't work for these conditionally formatted cells (which is terrible because these sheets are the reason I wrote the macro in the first place!). If anyone has any suggestions, you'd be a life saver!

Here it is,

Sub Clear_Contents_If_Highlighted()
Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1:Z500")
For Each cell In rng
cell.Select
If ActiveCell.Interior.ColorIndex = 6 Then
cell.Clear
End If
Next
End Sub

**xld** · 10-15-2008, 07:23 AM

Do you want to delete all CF cells, or just those cells where any of the CF conditions are TRUE?

**luckylindy345** · 10-15-2008, 07:37 AM

Originally Posted by xld

Do you want to delete all CF cells, or just those cells where any of the CF conditions are TRUE?

Just the ones where the CF is true!

**xld** · 10-15-2008, 09:07 AM

Sub Clear_Contents_If_Highlighted()
Dim rng As Range
Dim cell As Range
    Set rng = Sheets("Sheet1").Range("A1:Z500")
    For Each cell In rng
        If IsCFMet(cell) Then cell.Clear
    Next
End Sub

'---------------------------------------------------------------------
Public Function IsCFMet(rng As Range) As Boolean
'---------------------------------------------------------------------
Dim oFC As FormatCondition
Dim sF1 As String
Dim iRow As Long
Dim iColumn As Long

   Set rng = rng(1, 1)
   If rng.FormatConditions.Count > 0 Then
      For Each oFC In rng.FormatConditions
         If oFC.Type = xlCellValue Then
            Select Case oFC.Operator
               Case xlEqual
                  IsCFMet = rng.Value = oFC.Formula1
               Case xlNotEqual
                  IsCFMet = rng.Value <> oFC.Formula1
               Case xlGreater
                  IsCFMet = rng.Value > oFC.Formula1
               Case xlGreaterEqual
                  IsCFMet = rng.Value >= oFC.Formula1
               Case xlLess
                  IsCFMet = rng.Value < oFC.Formula1
               Case xlLessEqual
                  IsCFMet = rng.Value <= oFC.Formula1
                  IsCFMet = (rng.Value >= oFC.Formula1 And _
                             rng.Value <= oFC.Formula2)
               Case xlNotBetween
                  IsCFMet = (rng.Value < oFC.Formula1 Or _
                             rng.Value > oFC.Formula2)
            End Select
         Else
             're-adjust the formula back to the formula that applies
             'to the cell as relative formulae adjust to the activecell
            With Application
               iRow = rng.Row
               iColumn = rng.Column
               sF1 = .Substitute(oFC.Formula1, "ROW()", iRow)
               sF1 = .Substitute(sF1, "COLUMN()", iColumn)
               sF1 = .ConvertFormula(sF1, xlA1, xlR1C1)
               sF1 = .ConvertFormula(sF1, xlR1C1, xlA1, , rng)
            End With
            IsCFMet = rng.Parent.Evaluate(sF1)
         End If
         If IsCFMet Then Exit Function
     Next oFC
   End If 'rng.FormatConditions.Count > 0

End Function