Excel VBA module does not ignore blank cells

Question

I have a VBA module I got online to count cell with conditional formatting. This module has an issue in that it returns an error if in the range it is counting, a cell is either blank or does not have a conditional format rule. The module is:

Function CountCFCells(rng As Range, C As Range)
Dim i As Single, j As Long, k As Long
Dim chk As Boolean, Str1 As String, CFCELL As Range
chk = False
For i = 1 To rng.FormatConditions.Count
    If rng.FormatConditions(i).Interior.ColorIndex = C.Interior.ColorIndex Then
        chk = True
        Exit For
    End If
Next i
j = 0
k = 0
If chk = True Then
    For Each CFCELL In rng
        Str1 = CFCELL.FormatConditions(i).Formula1
        Str1 = Application.ConvertFormula(Str1, xlA1, xlR1C1)
        Str1 = Application.ConvertFormula(Str1, xlR1C1, xlA1, , ActiveCell.Resize(rng.Rows.Count, rng.Columns.Count).Cells(k + 1))
        If Evaluate(Str1) = True Then j = j + 1
        k = k + 1
    Next CFCELL
Else
CountCFCells = "Color not found"
Exit Function
End If
CountCFCells = j
End Function

When I call this function using =CountCFCells(A1:A30, B1), I want it to ignore any cells don't have any conditional formating rules or data (type is number). What is the best way to disregard any cells in the range that do not have conditional formatting rules or data?

what have you tried so far? You ask for the best way, have you figured out any way to do it? — ivan7707
No, i have no solution so far. The code works even if the cell is black as long as there are conditional formatting rules applied. But, I would like it to ignore cells without conditional formatting rules applied. — Britt

Brumder Brumder · Accepted Answer · 2015-09-29T20:45:53

Okay you have a few errors. The code isn't designed to handle a cell ("CFCELL") where conditional formatting is nonexistent (blank cells should actually be okay in the above code so long as they're assigned a rule).

So, let's try this instead:

Function CountCFCells(rng As Range, C As Range) As Long
Dim i As Single, j As Long, Total As Long
Dim CFCELL As Range
Dim Match_CI As Long

j = 0
Match_CI = C.Interior.ColorIndex

For Each CFCELL In rng
    If CFCELL.FormatConditions.Count > 0 And Len(CFCELL) > 0 Then
        If DisplayedColor(CFCELL) = Match_CI Then
            j = j + 1
        End If
    End If
Next CFCELL

Total = j
CountCFCells = Total

End Function


Function DisplayedColor(Cell As Range, Optional CellInterior As Boolean = True, _
                        Optional ReturnColorIndex As Long = True) As Long
  Dim X As Long, Test As Boolean, CurrentCell As String
  If Cell.Count > 1 Then Err.Raise vbObjectError - 999, , "Only single cell references allowed for 1st argument."
  CurrentCell = ActiveCell.Address
  For X = 1 To Cell.FormatConditions.Count
    With Cell.FormatConditions(X)
      If .Type = xlCellValue Then
        Select Case .Operator
          Case xlBetween:      Test = Cell.Value >= Evaluate(.Formula1) And Cell.Value <= Evaluate(.Formula2)
          Case xlNotBetween:   Test = Cell.Value <= Evaluate(.Formula1) Or Cell.Value >= Evaluate(.Formula2)
          Case xlEqual:        Test = Evaluate(.Formula1) = Cell.Value
          Case xlNotEqual:     Test = Evaluate(.Formula1) <> Cell.Value
          Case xlGreater:      Test = Cell.Value > Evaluate(.Formula1)
          Case xlLess:         Test = Cell.Value < Evaluate(.Formula1)
          Case xlGreaterEqual: Test = Cell.Value >= Evaluate(.Formula1)
          Case xlLessEqual:    Test = Cell.Value <= Evaluate(.Formula1)
        End Select
      ElseIf .Type = xlExpression Then
        Application.ScreenUpdating = False
        Cell.Select
        Test = Evaluate(.Formula1)
        Range(CurrentCell).Select
        Application.ScreenUpdating = True
      End If
      If Test Then
        If CellInterior Then
          DisplayedColor = IIf(ReturnColorIndex, .Interior.ColorIndex, .Interior.color)
        Else
          DisplayedColor = IIf(ReturnColorIndex, .Font.ColorIndex, .Font.color)
        End If
        Exit Function
      End If
    End With
  Next
  If CellInterior Then
    DisplayedColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.color)
  Else
    DisplayedColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.color)
  End If
End Function

This will count all cells which have conditional formatting rules applied to them containing data within the selected range. It will only match entries which are the same color as cell you select second in the formula. In this case, I made it so it counts user-entered zero's as a value (will not skip it if someone actually entered a zero).

Excel VBA module does not ignore blank cells

1 Answers