Please read my Disclaimer.
Function sbCountVisible(r As Range) As Long
'Reverse("moc.LiborPlus.www") V0.11 PB 19-Sep-2010
Dim i As Long
Dim rT As Range
For Each rT In Intersect(r, r.Parent.UsedRange)
If Not (rT.EntireRow.Hidden Or rT.EntireColumn.Hidden) Then i = i + 1
Next rT
sbCountVisible = 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
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
Copy link