ThreeWave CountType VBA Function

This page describes the CountType function that counts the number of cells of a given content type in a range of cells.
ShortFadeBar

Introduction

There are few built in functions in Excel for counting the number of cells in a range that contain a certain type of content. You can use COUNT to count the number of numeric values, COUNTA to count the number of non-blank cells, and COUNTBLANK to count the number of blank cells.

You can extend the reach of formulas with some array formulas. For example, the formula

=SUMPRODUCT(1*(ISERROR($A$1:$A$10)))

will return the number of errors in the range A1:A10. Similarly, the formula

=SUMPRODUCT(1*(ISERR($A$1:$A$10)))

will return the number of errors excluding #N/A errors in A1:A10.

But beyond these basics, there is little you can do with formulas. The primary obstacle is the functionality of the TYPE function. This function returns a value indicating what sort of data is contained in a cell. However, you cannot use TYPE in an array formula because it is designed to take an array as a possible input and does not return a series of values representing the type of each element in the array, as is required for an array function to work properly. If you array enter a formula like =SUM(TYPE(A1:A10)), the TYPE function will return 64, indicating an array, rather than an array of numbers representing the types of each cell in A1:A10.

SectionBreak

The CountType VBA Function

The rest of this article describes the CountType VBA function that picks up where the built in functions leave off. It takes as input parameters a range of cells to test and a value indicating what type of content to test for. The result is the number of cells that are of the specified content type.

You can download a bas module file here that contains all the code shown below.

The function declaration for CountType is shown below:

Public Function CountType(InputRange As Range, CountTypeOf As cstCountType) As Variant

where InputRange is the range of cells to test and CountTypeOf indicates the type of values to test for. The possible values for CountTypeOf are declared in an Enum variable, as shown below.

Public Enum cstCountType 
    cstTypeNonBlank = 1
    cstTypeNumbers = 2
    cstTypeText = 4
    cstTypeFormulas = 8
    cstTypeNonFormulas = 16
    cstTypeErrors = 32
    cstTypeBlanks = 64
    cstTypeBoolean = 128
    cstTypeDateTime = 256
    cstTypeAll = 4096
End Enum


You can add more than one element of cstCountType to perform an additive count. For example, you can pass cstTypeNumbers + cstTypeFormulas to return the count of cells that are either numeric or formulas. Combining elements of cstCountType causes the code to work in an Or fashion, counting cells that are one type Or another type.

Although I generally frown on the use of the VBA GoTo statement, this code uses GoTo to jump to the bottom of the main loop once a match is found for a cell. This prevents double counting of cell contents and considerably streamlines the logic of the code.

The descriptions of the values of cstCountType are described below:

cstTypeNonBlank = 1
Return the number of non-blank cells. A cell is considered blank if it contains no data or if it contains a formula that returns an empty string.

cstTypeNumbers = 2
Return of the number of numeric cells. The cell must be an actual number. Boolean values (TRUE and FALSE) and date or time values are not considered to be numeric.

cstTypeText = 4
Return the number of text cells. A cell is considered to contain text if it contains static text (but not a Boolean, Date Time, or numeric string) or contains a formula that returns a non-blank result. If a cell contains a formula that returns an empty string, that cell is not considered to contain text.

cstTypeFormulas = 8
Return the number of cells that contain a formula, regardless of the result of the formula. The formula may return any value, including an empty string or an error value.

cstTypeNonFormulas = 16
Return the number of cells that do not contain formula. The cell may contain any value or no value at all.

cstTypeErrors = 32
Return the number of cells that have any error value.

cstTypeBlanks = 64
Returns the number of cells that are blank. A cell is considered to be blank if it contains no data or contains a formula that evaluates to an empty string.

cstTypeBoolean = 128
Returns the number of cells that contain a Boolean value (TRUE or FALSE). The Boolean value may be static text or the result of a formula.

cstTypeDateTime = 256
Returns the number of dates or date/time values. The cell value may be static or the result of a formula. The text in the cell must be a valid date or date/time string.

cstTypeAll = 4096
Returns the total number of cells in the range, regardless of content.

SectionBreak

CountType Code

Option Explicit
Option Compare Text

''''''''''''''''''''''''''''''''''''''
' This enum lists the possible types
' of data to count with the CountType
' function.
''''''''''''''''''''''''''''''''''''''
Public Enum cstCountType
    cstTypeNonBlank = 1
    cstTypeNumbers = 2
    cstTypeText = 4
    cstTypeFormulas = 8
    cstTypeNonFormulas = 16
    cstTypeErrors = 32
    cstTypeBlanks = 64
    cstTypeBoolean = 128
    cstTypeDateTime = 256
    cstTypeAll = 4096
End Enum

Public Function CountType(InputRange As Range, CountTypeOf As cstCountType) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CountType
' By Chip Pearson, 22-August-2007.
' Documentation at  http://www.cpearson.com/Excel/CountType.aspx
' Granted to the Public Domain.
' This function returns the number of cells in InputRange that are of the type
' specified by CountTypeOf.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim R As Range
Dim D As Date
Dim CellCount As Long
Application.Volatile True
On Error GoTo ErrH

''''''''''''''''''''''''''''''''
' If the InputRange is Nothing
' get out immediately.
''''''''''''''''''''''''''''''''
If InputRange Is Nothing Then
    CountType = 0
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''
' cstTypeAll returns the total
' cell count, regardless of content.
'''''''''''''''''''''''''''''''''''''
If CountTypeOf = cstTypeAll Then
    CountType = InputRange.Cells.Count
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''
' Loop through the cells in the
' InputRange, testing each condition
' and keeping a running total of each
' data type.
''''''''''''''''''''''''''''''''''''
For Each R In InputRange.Cells
    
    '''''''''''''''''''''''''''''''''''''
    ' cstTypeBlanks
    '''''''''''''''''''''''''''''''''''''
    If (CountTypeOf And cstTypeBlanks) Then
        If R.HasFormula = False Then
            If R.Text = vbNullString Then
                CellCount = CellCount + 1
                GoTo EndOfLoop
            End If
        Else
            If R.Text = vbNullString Then
                CellCount = CellCount + 1
                GoTo EndOfLoop
            End If
        End If
    End If
    
    ''''''''''''''''''''''''''''''''''''''
    ' cstTypeBoolean
    ''''''''''''''''''''''''''''''''''''''
    If (CountTypeOf And cstTypeBoolean) Then
        If (StrComp(CStr(R.Text), "TRUE") = 0) Or (StrComp(CStr(R.Text), "FALSE") = 0) Then
            CellCount = CellCount + 1
            GoTo EndOfLoop
        End If
    End If
    
    ''''''''''''''''''''''''''''''''''''''
    ' cstTypeNonBlank
    ''''''''''''''''''''''''''''''''''''''
    If (CountTypeOf And cstTypeNonBlank) Then
        If R.Text <> vbNullString Then
            CellCount = CellCount + 1
            GoTo EndOfLoop
        End If
    End If
    
    ''''''''''''''''''''''''''''''''''''''
    ' cstTypeNumbers
    ''''''''''''''''''''''''''''''''''''''
    If (CountTypeOf And cstTypeNumbers) Then
        If R.Text <> vbNullString Then
            If IsNumeric(R.Value) Then
                On Error Resume Next
                Err.Clear
                D = DateValue(R.Text)
                If Err.Number <> 0 Then
                    If ((StrComp(CStr(R.Value), "TRUE", vbTextCompare) <> 0) And _
                        ((StrComp(CStr(R.Value), "FALSE", vbTextCompare) <> 0))) Then
                        CellCount = CellCount + 1
                        GoTo EndOfLoop
                    End If
                End If
            End If
        End If
    End If
    
    ''''''''''''''''''''''''''''''''''''''
    ' cstTypeText
    ''''''''''''''''''''''''''''''''''''''
    If (CountTypeOf And cstTypeText) Then
        On Error Resume Next
        If R.Text <> vbNullString Then
            If IsNumeric(R.Value) = False Then
                If IsError(R.Value) = False Then
                    Err.Clear
                    D = DateValue(R.Text)
                    If Err.Number <> 0 Then
                        CellCount = CellCount + 1
                        GoTo EndOfLoop
                    End If
                End If
            End If
        End If
        On Error GoTo 0
    End If
    
    ''''''''''''''''''''''''''''''''''''''
    ' cstTypeFormulas
    ''''''''''''''''''''''''''''''''''''''
    If (CountTypeOf And cstTypeFormulas) Then
        If R.HasFormula = True Then
            CellCount = CellCount + 1
            GoTo EndOfLoop
        End If
    End If
    
    ''''''''''''''''''''''''''''''''''''''
    ' cstTypeNonFormulas
    ''''''''''''''''''''''''''''''''''''''
    If (CountTypeOf And cstTypeNonFormulas) Then
        If R.HasFormula = False Then
            CellCount = CellCount + 1
            GoTo EndOfLoop
        End If
    End If
    
    ''''''''''''''''''''''''''''''''''''''
    ' cstTypeErrors
    ''''''''''''''''''''''''''''''''''''''
    If (CountTypeOf And cstTypeErrors) Then
        If IsError(R.Value) Then
            CellCount = CellCount + 1
            GoTo EndOfLoop
        End If
    End If

    ''''''''''''''''''''''''''''''''''''''
    ' cstTypeDateTime
    ''''''''''''''''''''''''''''''''''''''
    If (CountTypeOf And cstTypeDateTime) Then
        On Error Resume Next
        Err.Clear
        D = DateValue(CStr(R.Text))
        If Err.Number = 0 Then
            CellCount = CellCount + 1
            GoTo EndOfLoop
        Else
            Err.Clear
            D = TimeValue(CStr(R.Text))
            If Err.Number = 0 Then
                CellCount = CellCount + 1
                GoTo EndOfLoop
            End If
        End If
        On Error GoTo ErrH
    End If

''''''''''''''''''''''''''''''''''''''
' end of cell loop
''''''''''''''''''''''''''''''''''''''
EndOfLoop:
Next R
        
''''''''''''''''''''''''''''''''''''''
' Return the result CellCount.
''''''''''''''''''''''''''''''''''''''
CountType = CellCount

''''''''''''''''''''''''''''''''''''''
' Exit Function
''''''''''''''''''''''''''''''''''''''
Exit Function

'''''''''''''''''''''''''''''''''''''''''''''''
' ErrH Error Handler: Should never get here.
'''''''''''''''''''''''''''''''''''''''''''''''
ErrH:
CountType = "ERROR: Cell: " & R.Address(False, False)

End Function

You can download a bas module file here that contains all the code shown above.

This page last updated: 22-August-2007

-->