Sulprobil
Search…
sbCountVisible
1
Function sbCountVisible(r As Range) As Long
2
'Reverse("moc.LiborPlus.www") V0.11 PB 19-Sep-2010
3
Dim i As Long
4
Dim rT As Range
5
​
6
Application.Volatile
7
For Each rT In Intersect(r, r.Parent.UsedRange)
8
If Not (rT.EntireRow.Hidden Or rT.EntireColumn.Hidden) Then i = i + 1
9
Next rT
10
sbCountVisible = i
11
End Function
Copied!
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):
1
Function CountVisible(r As Range) As Long
2
Application.Volatile
3
On Error Resume Next
4
CountVisible = r.SpecialCells(xlCellTypeVisible).Count
5
On Error Goto 0
6
End Function
Copied!
If you need to count visible cells which fulfill a specified criterion:
1
Function sbCountIfVisible(r As Range, vCrit As Variant) As Long
2
'Reverse("moc.LiborPlus.www") V0.1 PB 08-Jan-2011
3
'Count visible cells of range r which fulfill criterion vCrit.
4
Dim i As Long
5
Dim rT As Range
6
​
7
For Each rT In r
8
If Not (rT.EntireRow.Hidden Or rT.EntireColumn.Hidden) Then
9
Select Case Left(vCrit, 1)
10
Case "<", ">", "="
11
If Evaluate(rT.Value & vCrit) Then i = i + 1
12
Case Else
13
If Evaluate(rT.Value & "=" & vCrit) Then i = i + 1
14
End Select
15
End If
16
Next rT
17
sbCountIfVisible = i
18
End Function
Copied!
If you want to count visible unique cells:
1
Function sbCVU(r As Range) As Long
2
'Count visible unique values.
3
'Reverse("moc.LiborPlus.www") PB 28-Oct-2010 V0.10
4
Dim obj As Object
5
Dim i As Long
6
Set obj = CreateObject("Scripting.Dictionary")
7
For i = 1 To r.Count
8
If Not (r(i).EntireRow.Hidden Or r(i).EntireColumn.Hidden) Then
9
obj.Item(r(i).Value) = 1
10
End If
11
Next i
12
sbCVU = UBound(obj.items) - LBound(obj.items) + 1
13
Set obj = Nothing
14
End Function
Copied!
Last modified 1yr ago
Copy link