I am a supporter of
St. Joseph's hospice.
 If you find this site useful or if it helped you, consider a small donation to
St. Joseph's, please.

Information on
St. Joseph's

JustGiving - Sponsor me now!

 

Count Visible Cells

Function CountVisible(r As Range) As Long
'Reverse("moc.LiborPlus.www") V0.11 PB 19-Sep-2010
Dim i As Long
Dim rT As Range

Application.Volatile
For Each rT In Intersect(r, r.Parent.UsedRange)
    If Not (rT.EntireRow.Hidden Or rT.EntireColumn.Hidden) Then i = i + 1
Next rT
CountVisible = i
End Function

An alternative if you do not have more than 8,192 non-continuous areas in your input range (not likely but then Excel deletes your data, this is a known bug, thanks to a forum's discussion of Gary's Student, Rick Rothstein and Ron de Briun):

Function CountVisible(r As Range) As Long
Application.Volatile
On Error Resume Next
CountVisible = r.SpecialCells(xlCellTypeVisible).Count
On Error Goto 0
End Function

If you need to count visible cells which fulfill a specified criterion:

Function sbCountIfVisible(r As Range, vCrit As Variant) As Long
'Reverse("moc.LiborPlus.www") V0.1 PB 08-Jan-2011
'Count visible cells of range r which fulfill criterion vCrit.
Dim i As Long
Dim rT As Range

For Each rT In r
    If Not (rT.EntireRow.Hidden Or rT.EntireColumn.Hidden) Then
        Select Case Left(vCrit, 1)
        Case "<", ">", "="
            If Evaluate(rT.Value & vCrit) Then i = i + 1
        Case Else
            If Evaluate(rT.Value & "=" & vCrit) Then i = i + 1
        End Select
    End If
Next rT
sbCountIfVisible = i
End Function

If you want to count visible unique cells:

Function sbCVU(r As Range) As Long
'Count visible unique values.
'Reverse("moc.LiborPlus.www") PB 28-Oct-2010 V0.10
Dim obj As Object
Dim i As Long
Set obj = CreateObject("Scripting.Dictionary")
For i = 1 To r.Count
    If Not (r(i).EntireRow.Hidden Or r(i).EntireColumn.Hidden) Then
        obj.Item(r(i).Value) = 1
    End If
Next i
sbCVU = UBound(obj.items) - LBound(obj.items) + 1
Set obj = Nothing
End Function

Sulprobil   Get it done   Contact   Disclaimer   Download