# AVERAGEIFSVISIBLE

Returns the arithmetic mean of all the visible numbers in a range that satisfies multiple conditions.
This function is very similar to the AVERAGEIFS function except this function will exclude any cells that are hidden.
For instructions on how to add a function to a workbook refer to the page under Inserting Functions

`Public Function AVERAGEIFSVISIBLE(ByVal rgeAverageRange As Range, _                                   ParamArray avCriteriaAndRanges() As Variant) As Variant                           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 sngaverage As Single Dim sngmedian As Single Dim vcell As Range Dim vcellvalue As Variant    Application.Volatile (True)    If UBound(avCriteriaAndRanges, 1) Mod 2 > 0 Then       'not the correct amount of arguments   End If    ReDim avCriterias(UBound(avCriteriaAndRanges, 1))    ReDim asCriterias(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)) = "Range" Then          sCriteria = CStr(avCriteriaAndRanges(iitemcount + 1).Value)       End If       If TypeName(avCriteriaAndRanges(iitemcount + 1)) = "Boolean" Then          sCriteria = CStr(CBool(avCriteriaAndRanges(iitemcount + 1)))       End If       If TypeName(avCriteriaAndRanges(iitemcount + 1)) = "String" Then          sCriteria = CStr(avCriteriaAndRanges(iitemcount + 1))       End If             Set avCriterias(icriteriacount - 1) = rgeCriteria       asCriterias(icriteriacount - 1) = sCriteria       icriteriacount = icriteriacount + 1    Next iitemcount       ReDim Preserve avCriterias(icriteriacount - 2)    ReDim Preserve asCriterias(icriteriacount - 2)          'must all have the same number of rows   ReDim arsngvalues(avCriterias(0).Rows.Count)            For lrowno = 1 To rgeCriteria.Rows.Count       Set vcell = rgeCriteria.Parent.Cells(rgeCriteria.Row + lrowno - 1, rgeAverageRange.Column)       vcellvalue = rgeCriteria.Parent.Cells(rgeCriteria.Row + lrowno - 1, rgeAverageRange.Column).Value             If Row_MatchesAllCriteria(lrowno, avCriterias, asCriterias) = True And _          IsNumeric(vcellvalue) = True And _          vcell.EntireRow.Hidden = False Then                   lmatch = lmatch + 1          sngaverage = sngaverage + vcellvalue       End If       If lmatch > 0 And IsEmpty(vcellvalue) = True Then Exit For    Next lrowno            If (lmatch = 0) Then AVERAGEIFSVISIBLE = VBA.CVErr(XlCVError.xlErrDiv0)    If (lmatch > 0) Then AVERAGEIFSVISIBLE = sngaverage / lmatch 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 = 0 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 = 0 To UBound(avCriterias, 1)       iconditioncolno = avCriterias(icriteriacount).Column                   Dim tempCondition As String       Dim tempCellValue As String       tempCondition = asCriterias(icriteriacount)       'check the symbol and add the default equals if not there      If ((Left(tempCondition, 1) <> "<") And _           (Left(tempCondition, 1) <> ">")) Then                    If (Left(tempCondition, 1) <> "=") Then tempCondition = "=" & tempCondition       End If             tempCellValue = avCriterias(icriteriacount).Parent.Cells(avCriterias(icriteriacount).Row + lrowno - 1, iconditioncolno).Value       If (Criteria_Check(tempCondition, tempCellValue) = True) Then       Else          bmatch = False       End If            Next icriteriacount            Row_MatchesAllCriteria = bmatch End Function Public Function Criteria_Check(ByVal sCriteria As String, _                                ByVal sValue As String) As Boolean         If ((InStr(sCriteria, "*") > 0) And (InStr(sCriteria, "~*") = 0)) Or _        ((InStr(sCriteria, "?") > 0) And (InStr(sCriteria, "~?") = 0)) Then         If (Left(sCriteria, 1) = "=") Then sCriteria = Right(sCriteria, Len(sCriteria) - 1)         Criteria_Check = (sValue Like sCriteria)         Exit Function     End If     If (Left(sCriteria, 1) = "=") Then         Criteria_Check = (sValue = Right(sCriteria, Len(sCriteria) - 1))         Exit Function     End If     If (Left(sCriteria, 1) = ">") And _        (Left(sCriteria, 2) <> ">=") Then         Criteria_Check = (CSng(sValue) > CSng(Right(sCriteria, Len(sCriteria) - 1)))         Exit Function     End If     If (Left(sCriteria, 1) = "<") And _        (Left(sCriteria, 2) <> "<=") And (Left(sCriteria, 2) <> "<>") Then         Criteria_Check = (CSng(sValue) < CSng(Right(sCriteria, Len(sCriteria) - 1)))         Exit Function     End If     If (Left(sCriteria, 2) = ">=") Then         Criteria_Check = (CSng(sValue) >= CSng(Right(sCriteria, Len(sCriteria) - 2)))         Exit Function     End If     If (Left(sCriteria, 2) = "<=") Then         Criteria_Check = (CSng(sValue) <= CSng(Right(sCriteria, Len(sCriteria) - 2)))         Exit Function     End If     If (Left(sCriteria, 2) = "<>") Then         Criteria_Check = (CSng(sValue) <> CSng(Right(sCriteria, Len(sCriteria) - 2)))         Exit Function     End If     Criteria_Check = sValue Like sCriteria End Function `

© 2022 Better Solutions Limited