Option Explicit 
 
Public Function COUNTCASES(EvalRange As Excel.Range, _ 
    Optional EvalExtend As Boolean = False) As String 
     '   Count cells in a range based on a particular case
    Application.Volatile True 
     
    Dim rCell As Excel.Range 
    Dim lUcase As Long 
    Dim lLcase As Long 
    Dim lTcase As Long 
    Dim lMixCase As Long 
     
    Dim lFormula As Long 
    Dim lNum As Long 
    Dim lDate As Long 
    Dim lEmpty As Long 
     
     
     '   Loop through the Selected range:
    For Each rCell In EvalRange 
         
         
         '   If user set the optional argument to "True" then we
         '   will evaluate what is contained in each cell,
         '   and deliver a different result
        If Not EvalExtend Then 
             
             
             
             '       To get mixed case string, we eliminate looking at:
             '       Formulas, Numerics, Dates, and Empty cells
            If Not rCell.HasFormula Then 
                If Not IsNumeric(rCell) Then 
                    If Not IsDate(rCell) Then 
                        If Not IsEmpty(rCell) Then 
                             
                             
                             '           Count all "UPPER" case text
                            If UCase$(rCell) = rCell Then lUcase = lUcase + 1: GoTo NextEval 
                             
                             
                             '           Count all "lower" case text
                            If LCase$(rCell) = rCell Then lLcase = lLcase + 1: GoTo NextEval 
                             
                             
                             '           Count all "Proper" (Title) case text
                            If Application.Proper(rCell) = rCell Then lTcase = lTcase + 1: GoTo NextEval 
                             
                             
                             '           Left overs we count as mixed:
                            lMixCase = lMixCase + 1: GoTo NextEval 
                             
                             
                        End If 
                    End If 
                End If 
            End If 
             
        Else 
             
             '           Count all Empties:
            If IsEmpty(rCell) Then lEmpty = lEmpty + 1: GoTo NextEval 
             
             
             '           Count all formulas:
            If rCell.HasFormula Then lFormula = lFormula + 1: GoTo NextEval 
             
             
             '           Count all Numerics:
            If IsNumeric(rCell) Then lNum = lNum + 1: GoTo NextEval 
             
             
             '           Count all dates:
            If IsDate(rCell) Then lDate = lDate + 1: GoTo NextEval 
             
             
             
             '           Count all "UPPER" case text:
            If UCase$(rCell) = rCell Then lUcase = lUcase + 1: GoTo NextEval 
             
             
             
             '           Count all "lower" case text:
            If LCase$(rCell) = rCell Then lLcase = lLcase + 1: GoTo NextEval 
             
             
             
             '           Count all "Proper" (Title) case text:
            If Application.Proper(rCell) = rCell Then lTcase = lTcase + 1: GoTo NextEval 
             
             
             '           Left overs we count as mixed:
            lMixCase = lMixCase + 1: GoTo NextEval 
             
             
        End If 
         
         
         
NextEval: 
    Next rCell 
     
     
     '   =============================================
     '   If no optional argument:
    If Not EvalExtend Then 
         
        COUNTCASES = lUcase & " UpperCase, " & _ 
        lLcase & " LowerCase, " & _ 
        lTcase & " ProperCase, " & _ 
        lMixCase & " MixedCase" 
         '   =============================================
         
    Else 
         
         '   =============================================
         '   If optional argument specified:
        COUNTCASES = lUcase & " UpperCase, " & _ 
        lLcase & " LowerCase, " & _ 
        lTcase & " ProperCase, " & _ 
        lMixCase & " MixedCase, " & _ 
        lFormula & " Formula, " & _ 
        lNum & " Numeric, " & _ 
        lDate & " Date, " & _ 
        lEmpty & " Empty" 
         '   =============================================
         
    End If 
     
End Function