I need help to create a miniifs vba function? - vba

Question

I do some macro and i upgrade a macro of Diedrich to have a MaxIfs in excel 2010 which work with line an columns i put the code under.
Public Function maxifs(MaxRange As Range, ParamArray Criteria() As Variant) As Variant
Application.Volatile
Dim n As Long
Dim i, j As Long
Dim c As Variant
Dim f As Boolean
Dim w() As Long
Dim k As Long
Dim z As Variant
'Error if less than 1 criteria
On Error GoTo ErrHandler
n = UBound(Criteria)
If n < 1 Then
'too few criteria
GoTo ErrHandler
End If
'Define k
k = 0
'Loop through cells of max range
For i = 1 To MaxRange.Count
For j = 1 To MaxRange.Count
'Start by assuming there is a match
f = True
'Loop through conditions
For c = 0 To n - 1 Step 2
'Does cell in criteria range match condition?
If Criteria(c).Cells(i, j).Value <> Criteria(c + 1) Then
f = False
End If
Next c
'Define z
z = MaxRange
'Were all criteria satisfied?
If f = True Then
k = k + 1
ReDim Preserve w(k)
w(k) = z(i, j)
End If
Next j
Next i
maxifs = Application.Max(w)
Exit Function
ErrHandler:
maxifs = CVErr(xlErrValue)
End Function
So now i will do the minifs and it does not work if all my value are positives.
How can i do?
ps: if you change in this macro max by median it will work too
Thanks for your answers.

Answer 1

It is because you are starting the array w with an empty slot at 0, since the first slot you fill is slot 1.
So w(0) is 0, Which when all the others are positive it is the minimum number.
So change K=-1 instead of K=0 When initially assigning value to k.
I also moved z in front of the loop, there is no reason to keep assigning that array. It only needs to be assigned once.
Also, I changed the ranges a little to only look at the used range, this way you can use full column references.
Also, the loops need to be through the rows and columns not two loops through the whole range as it causes many unnecessary loops.
Public Function minifs(MaxRange As Range, ParamArray Criteria() As Variant) As Variant
Application.Volatile
Dim n As Long
Dim i, j As Long
Dim c As Variant
Dim f As Boolean
Dim w() As Long
Dim k As Long
Dim z As Variant
'Error if less than 1 criteria
On Error GoTo ErrHandler
n = UBound(Criteria)
If n < 1 Then
'too few criteria
GoTo ErrHandler
End If
'Define z
z = Intersect(MaxRange, MaxRange.Parent.UsedRange).Value
'Define k
k = -1
'Loop through cells of max range
For i = 1 To UBound(z, 1)
For j = 1 To UBound(z, 2)
'Start by assuming there is a match
f = True
'Loop through conditions
For c = 0 To n - 1 Step 2
'Does cell in criteria range match condition?
If Intersect(Criteria(c), Criteria(c).Parent.UsedRange).Cells(i, j).Value <> Criteria(c + 1) Then
f = False
End If
Next c
'Were all criteria satisfied?
If f = True Then
k = k + 1
ReDim Preserve w(k)
w(k) = z(i, j)
End If
Next j
Next i
minifs = Application.Min(w)
Exit Function
ErrHandler:
minifs = CVErr(xlErrValue)
End Function
Also a note as this will only do = in the criteria and not any other function like >,<,<>,....