Vis and CountV VBA doesn't work on non-contiguous ranges

[stairstotheroad]

Hi Team,
Here's my objective: I have a range of student scores on assessments. I need the average score of the bottom 25% of performers (So if there are 20 students, I need the average of the lowest 5 scores). I have a formula to make this work, but I have a filter running, and I need the calculation cell to update based on whatever cells are visible. I have a code for this, and it works as long as my visible cells all appear in order. But if I filter for say grades 3 and 5 (not showing the 4th grade results in the middle), I get a value error.

Please help to either: 1. think of a new solution to meeting my goal, or 2. adjust my vba code so that it will not give me a value eror when selecting non-contiguous ranges.

Here is the formula I'm using: =(SUMIF(Vis(D16:D515), "<="&PERCENTILE(Vis(D16:D515),0.25)))/(COUNTIFv(D16:D515,"<="&PERCENTILE(Vis(D16:D515),0.25)))
^So D16:D515 contains the assessment data, but there will be values below cell 515, so I need the range to loop until the end of the data.

Here is the

Function Vis(Rin As Range) As Range
'Returns the subset of Rin that is visible
Dim Cell As Range
Application.Volatile
Set Vis = Nothing
For Each Cell In Rin
If Not (Cell.EntireRow.Hidden Or Cell.EntireColumn.Hidden) Then
If Vis Is Nothing Then
Set Vis = Cell
Else
Set Vis = Union(Vis, Cell)
End If
End If
Next Cell
End Function


Function COUNTIFv(Rin As Range, Condition As Variant) As Long
'Same as Excel COUNTIF worksheet function, except does not count
'cells that are hidden
Dim A As Range
Dim Csum As Long
Csum = 0
For Each A In Vis(Rin).Areas
Csum = Csum + WorksheetFunction.CountIf(A, Condition)
Next A
COUNTIFv = Csum
End Function

HELP!

 

[Rijnsent]

Hi stairs,
give this function a try. The three elements for the function are: the range, the percentile and a boolean value (true/false) to calculate all rows or only the visible ones (=true).
Cheers,
Koen

Function PERCENTILE_AVERAGE(Rng As Range, P As Double, VisibleOnly As Boolean)

Application.Volatile
Dim arrValues() As Double
Dim i As Long
Dim CalcRngCount As Double, CalcRngSum As Double

'Loop through the range and put all matching cells in an array
For Each myCell In Rng
    If (VisibleOnly = True And Not (myCell.EntireRow.Hidden Or myCell.EntireColumn.Hidden)) Or VisibleOnly = False Then
        ReDim Preserve arrValues(i)
        arrValues(i) = myCell.Value
        i = i + 1
    End If
Next myCell

PBound = Application.WorksheetFunction.Percentile(arrValues, P)
'Countif & Sumif don't accept arrays, just ranges, so loop over the array
CalcRngSum = 0
CalcRngCount = 0
For i = 0 To UBound(arrValues)
    If arrValues(i) <= PBound Then
        CalcRngSum = CalcRngSum + arrValues(i)
        CalcRngCount = CalcRngCount + 1
    End If
Next i

'Give the result back to the user, catch the divide by zero possibility
If CalcRngCount = 0 Then
    PERCENTILE_AVERAGE = 0
Else
    PERCENTILE_AVERAGE = CalcRngSum / CalcRngCount
End If

End Function