Count visible cells criteria in VBA

[Av8tordude]

I've done multiple search combination to find the answer, but unfortunately nothing matches what I looking for. I'm auto-filtering my data and I would like to count the number cells that is greater than 0 in VBA. Can someone assist.

Thank you kindly

 

[Fluff]

Maybe

Sub Av8tordude()
   Dim Cl As Range
   Dim Mytotal As Long
   
   For Each Cl In Range("D2", Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)
      If Cl.Value > 0 Then Mytotal = Mytotal + 1
   Next Cl
   MsgBox Mytotal
End Sub

 

[Av8tordude]

Awesome!!! Sincerely, thank you for the quick reply and the excellent work you provide. Great work!!

BTW...Nice touch on the Sub Routine title.

 

[Rick Rothstein]

Here is another UDF (user defined function) that you can try (I think it should involve less overall looping)...

Function ZeroCount()
  Dim Ar As Range
  For Each Ar In ActiveSheet.AutoFilter.Range.SpecialCells(xlVisible).Areas
    ZeroCount = ZeroCount + WorksheetFunction.CountIf(Ar, ">0")
  Next
End Function

 

[Av8tordude]

Every time I create a new filter criteria, it adds doubles then number displayed. any solutions for this

 

[Av8tordude]

Hi Rick,

the output results needs to be displayed in a userform label. Can you tell me how to display it in a userform label? Thank you for help

Here is another UDF (user defined function) that you can try (I think it should involve less overall looping)...

Function ZeroCount()
  Dim Ar As Range
  For Each Ar In ActiveSheet.AutoFilter.Range.SpecialCells(xlVisible).Areas
    ZeroCount = ZeroCount + WorksheetFunction.CountIf(Ar, ">0")
  Next
End Function

 

[Fluff]

Every time I create a new filter criteria, it adds doubles then number displayed. any solutions for this

Can you post the code you are usng

 

[Av8tordude]

Bascially, when I apply a filter, I want to count the number of cells in column P that is greater than 0. Vice-versa I want to know the opposite (<0). CCI is a label on a Userform.

    For Each Cl In Range("P18", Range("P" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)      If Cl.Value > 0 Then Win = Win + 1
      If Cl.Value < 0 Then Loss = Loss + 1
    Next Cl
    
    CCI.Caption = Win & "/" & Loss

 

[Fluff]

Do you use Win or Loss elsewhere in the code?

 

[Av8tordude]

No...This is the entire code.

Sub Filter()Dim Rng As Range, LRow As Long, VisibleRowCount As Long


Application.EnableEvents = False
Set Rng = Range("A17", Range("A" & Rows.Count).End(xlUp)).Resize(, 17)
LRow = Range("A" & Rows.Count).End(xlUp).Row


Rng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("R2:X3"), Unique:=False
Range([A18], Cells(Rows.Count, "A")).SpecialCells(xlCellTypeVisible)(1).Select
VisibleRowCount = Rng.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1


If VisibleRowCount = 0 Then
    CCP.Caption = 0
    CCI.Caption = "$0.00"
    CPL.Caption = "$0.00"
    CGL.Caption = "0.00%"
Else
    CCP.Caption = WorksheetFunction.Subtotal(3, Range("A18:A" & LRow))
    For Each Cl In Range("P18", Range("P" & Rows.Count).End(xlUp)).SpecialCells(xlVisible)
      If Cl.Value > 0 Then Win = Win + 1
      If Cl.Value < 0 Then Loss = Loss + 1
    Next Cl
    
    CCI.Caption = Win & "/" & Loss
    
    CCI.Caption = Format(WorksheetFunction.Subtotal(1, Range("L18:L" & LRow)), "$#,0.00")
    CPL.Caption = Format(WorksheetFunction.Subtotal(9, Range("P18:P" & LRow)), "$#,#0.00")
    CGL.Caption = Format(WorksheetFunction.Subtotal(9, Range("P18:P" & LRow)) / WorksheetFunction.Subtotal(9, Range("L18:L" & LRow)), "0.00%")
End If


If WorksheetFunction.Subtotal(9, Range("P18:P" & LRow)) < 0 Then
    CPL.ForeColor = vbRed
    CGL.ForeColor = vbRed
ElseIf WorksheetFunction.Subtotal(9, Range("P18:P" & LRow)) > 0 Then
    CPL.ForeColor = RGB(0, 176, 80)
    CGL.ForeColor = RGB(0, 176, 80)
Else
    CPL.ForeColor = vbBlack
    CGL.ForeColor = vbBlack
End If
MyChart
Application.EnableEvents = True
End Sub

Do you use Win or Loss elsewhere in the code?