Returns the number of visible non blank cells that satisfies multiple conditions.
For instructions on how to add a function to a workbook refer to the page under Inserting Functions


'rgeCountRange - 
'avCriteriaAndRanges -

Public Function COUNTIFSVISIBLE( _
   ByVal rgeCountRange As Range, _
   ParamArray avCriteriaAndRanges() As Variant) As Single
Dim avCriterias() As Range
Dim asCriterias() As String
Dim icriteriacount As Integer
Dim rgeCriteria As Range
Dim sCriteria As String
Dim iitemcount As Integer
Dim lrowno As Long
Dim lmatch As Long
Dim arsngvalues() As Single
Dim sngmedian As Single
Dim bsorted As Boolean
Dim vcell As Range
Dim vcellvalue As Variant

   If UBound(avCriteriaAndRanges, 1) Mod 2 > 0 Then
'not the correct amount of arguments
   End If
   ReDim avCriterias(1 To UBound(avCriteriaAndRanges, 1))
   ReDim asCriterias(1 To UBound(avCriteriaAndRanges, 1))
   icriteriacount = 1
   For iitemcount = 0 To UBound(avCriteriaAndRanges, 1) Step 2
      If TypeName(avCriteriaAndRanges(iitemcount)) = "Range" Then
         Set rgeCriteria = avCriteriaAndRanges(iitemcount)
      End If
      If TypeName(avCriteriaAndRanges(iitemcount + 1)) = "String" Then
         sCriteria = CStr(avCriteriaAndRanges(iitemcount + 1))
      End If
      Set avCriterias(icriteriacount) = rgeCriteria
      asCriterias(icriteriacount) = sCriteria
      icriteriacount = icriteriacount + 1
   Next iitemcount

   For lrowno = 1 To rgeCriteria.Rows.Count
      Set vcell = rgeCriteria.Parent.Cells(rgeCriteria.Row + lrowno - 1, rgeCountRange.Column)
      vcellvalue = rgeCriteria.Parent.Cells(rgeCriteria.Row + lrowno - 1, rgeCountRange.Column).Value
      If Row_MatchesAllCriteria(lrowno, avCriterias, asCriterias) = True And _
         vcell.EntireRow.Hidden = False Then
         lmatch = lmatch + 1
      End If

      If lmatch > 0 And IsEmpty(vcellvalue) = True Then Exit For
   Next lrowno


End Function

Public Function Row_MatchesAllCriteria(ByVal lrowno As Long, _
                                       ByVal vArrayCriteria As Variant, _
                                       ByVal sArrayCriteria As Variant) As Boolean

Dim avCriterias() As Range
Dim asCriterias() As String
Dim rgeCriteria As Range
Dim sCriteria As String

Dim iitemcount As Integer
Dim bmatch As Boolean
Dim iconditioncolno As Integer
Dim icriteriacount As Integer

   ReDim avCriterias(UBound(vArrayCriteria, 1))
   ReDim asCriterias(UBound(sArrayCriteria, 1))

   For iitemcount = 1 To UBound(vArrayCriteria, 1)
      If TypeName(vArrayCriteria(iitemcount)) = "Range" Then
         Set rgeCriteria = vArrayCriteria(iitemcount)
      End If
      If TypeName(sArrayCriteria(iitemcount)) = "String" Then
         sCriteria = CStr(sArrayCriteria(iitemcount))
      End If

      Set avCriterias(iitemcount) = rgeCriteria
      asCriterias(iitemcount) = sCriteria
   Next iitemcount

   bmatch = True
   For icriteriacount = 1 To UBound(avCriterias, 1)
      iconditioncolno = avCriterias(icriteriacount).Column
      If avCriterias(icriteriacount).Parent.Cells(avCriterias(icriteriacount).Row + lrowno - 1, iconditioncolno).Value = _
                                                  asCriterias(icriteriacount) Then
         bmatch = False
      End If
   Next icriteriacount
   Row_MatchesAllCriteria = bmatch
End Function
alt text


You can use SUBTOTAL with 103 to achieve this
You can use AGGREGATE with 3 to achieve this

© 2022 Better Solutions Limited. All Rights Reserved. © 2022 Better Solutions Limited TopPrevNext