maxif function in vba

mienz · Nov 10th 2004

Hi
I want to write a reuseable maxif function in vba. The following code is working when entered directly into the cell:

= SUMPRODUCT(MAX((B1:B6=B2) * (A1:A6)))

Now I want to pack this function into vba code to make it commonly available. I tried it with the following code but it doesn't work. I assume there is a problem with the passing of the range parameters. I also tried it with String and Variant as parameter types - without success. Can anybody help me?

Code

Public Function MaxIF(criteriaRange As Range, searchValue As Variant, calcRange As Range)


AciveCell.Formula = "=SumProduct(Max((criteriaRange = searchValue) * (calcRange)))"


End Function

A9192Shark · Nov 10th 2004

Re: maxif function in vba

Mienz,

After wanting these functions for years I finally wrote these last month. They use the same structure as SumIf and CountIf functions (actually they use these functions to evaluate the function.)

HTH,

Alan.

Code

Option Explicit


'These functions have been developed by Alan Forster on 27th September 2004.
'After years of desire he has actually written them!
'The functions use the same evaluation methods as the CountIf and SumIf functions


Public Function MinIf(rngEvaluate As Range, _
                      strCondition As String, _
                      Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim bolValueSet         As Boolean
    Dim intRow              As Integer, _
        intCol              As Integer
        
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    bolValueSet = False
    If Not RangesOK(rngEvaluate, rngValues) Then
        'Return an error value
        varValue = "Error in range selection"
      Else
        'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    If bolValueSet Then
                        If varValue > rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol)
                      Else
                        bolValueSet = True
                        varValue = rngValues(intRow, intCol)
                    End If
                End If
            Next intCol
        Next intRow
    End If
    MinIf = varValue
End Function


Public Function MaxIf(rngEvaluate As Range, _
                      strCondition As String, _
                      Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim bolValueSet         As Boolean
    Dim intRow              As Integer, _
        intCol              As Integer
        
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    bolValueSet = False
    If Not RangesOK(rngEvaluate, rngValues) Then
        'Return an error value
        varValue = "Error in range selection"
      Else
        'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    If bolValueSet Then
                        If varValue < rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol)
                      Else
                        bolValueSet = True
                        varValue = rngValues(intRow, intCol)
                    End If
                End If
            Next intCol
        Next intRow
    End If
    MaxIf = varValue
End Function


Private Function RangesOK(rng1 As Range, rng2 As Range) As Boolean
    Dim bolAreas    As Boolean, _
        bolSize     As Boolean
    bolAreas = (rng1.Areas.Count = 1) Or (rng2.Areas.Count = 1)
    bolSize = (rng1.Rows.Count = rng2.Rows.Count) And _
              (rng1.Columns.Count = rng2.Columns.Count)
    RangesOK = bolAreas And bolSize
End Function

Display More

**Andy Pope** · Nov 10th 2004

Re: maxif function in vba

Hi mienz,

You need to break the variables away from the text within the formula.

Code

Public Function MaxIF(criteriaRange As Range, searchValue As Variant, calcRange As Range)


    ActiveCell.Formula = "=SumProduct(Max((" & _ 
criteriaRange.Address & "=" & searchValue & ") * (" & calcRange.Address & ")))"


End Function

You may also want to use relative reference in your function as it current uses absolute.

PS. Don't forget to use the code tags

MisterBates · Jul 6th 2006

Re: maxif function in vba - additional functions

Fantastic!

And it should be a simple matter to extend the set to include averageif, as well as versions that ignore blank/empty cells (sumaif, maxaif, minaif, averageaif) ...

... now attached (below). BTW, shouldn't the original code check to see that BOTH ranges have only one area (not either/or) ?

Code

Option Explicit
 
 'These functions (MinIf, MaxIf) have been developed by Alan Forster on 27th September 2004.
 'After years of desire he has actually written them!
 'The functions use the same evaluation methods as the CountIf and SumIf functions
 
Public Function MinIf(rngEvaluate As Range, _
    strCondition As String, _
    Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim bolValueSet         As Boolean
    Dim intRow              As Integer, _
    intCol              As Integer
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    bolValueSet = False
    If Not RangesOK(rngEvaluate, rngValues) Then
         'Return an error value
        varValue = "Error in range selection"
    Else
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    If bolValueSet Then
                        If varValue > rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol)
                    Else
                        bolValueSet = True
                        varValue = rngValues(intRow, intCol)
                    End If
                End If
            Next intCol
        Next intRow
    End If
    MinIf = varValue
End Function
 
Public Function MaxIf(rngEvaluate As Range, _
    strCondition As String, _
    Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim bolValueSet         As Boolean
    Dim intRow              As Integer, _
    intCol              As Integer
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    bolValueSet = False
    If Not RangesOK(rngEvaluate, rngValues) Then
         'Return an error value
        varValue = "Error in range selection"
    Else
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    If bolValueSet Then
                        If varValue < rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol)
                    Else
                        bolValueSet = True
                        varValue = rngValues(intRow, intCol)
                    End If
                End If
            Next intCol
        Next intRow
    End If
    MaxIf = varValue
End Function
 
Private Function RangesOK(rng1 As Range, rng2 As Range) As Boolean
    Dim bolAreas    As Boolean, _
    bolSize     As Boolean
    bolAreas = (rng1.Areas.Count = 1) And (rng2.Areas.Count = 1) ' Changed original "or" to "and"
    bolSize = (rng1.Rows.Count = rng2.Rows.Count) And _
    (rng1.Columns.Count = rng2.Columns.Count)
    RangesOK = bolAreas And bolSize
End Function


' Steve Bateman additions - 6 July 2006
Public Function AverageIf(rngEvaluate As Range, _
    strCondition As String, _
    Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim dblSum              As Double
    Dim lngCount            As Long
    Dim intRow              As Integer, _
    intCol              As Integer
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    If Not RangesOK(rngEvaluate, rngValues) Then
         'Return an error value
        varValue = "Error in range selection"
    Else
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    dblSum = dblSum + rngValues(intRow, intCol).Value2
                    lngCount = lngCount + 1
                End If
            Next intCol
        Next intRow
        varValue = dblSum / lngCount
    End If
    AverageIf = varValue
End Function


Public Function SumAIf(rngEvaluate As Range, _
    strCondition As String, _
    Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim dblSum              As Double
    Dim intRow              As Integer, _
    intCol              As Integer
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    If Not RangesOK(rngEvaluate, rngValues) Then
         'Return an error value
        varValue = "Error in range selection"
    Else
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Not (IsNumeric(rngValues(intRow, intCol).Text) Or IsDate(rngValues(intRow, intCol).Text)) Then
                    ' Ignore non-numeric/empty cells
                ElseIf Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    dblSum = dblSum + rngValues(intRow, intCol).Value2
                End If
            Next intCol
        Next intRow
        varValue = dblSum
    End If
    SumAIf = varValue
End Function


Public Function MinAIf(rngEvaluate As Range, _
    strCondition As String, _
    Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim bolValueSet         As Boolean
    Dim intRow              As Integer, _
    intCol              As Integer
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    bolValueSet = False
    If Not RangesOK(rngEvaluate, rngValues) Then
         'Return an error value
        varValue = "Error in range selection"
    Else
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Not (IsNumeric(rngValues(intRow, intCol).Text) Or IsDate(rngValues(intRow, intCol).Text)) Then
                    ' Ignore non-numeric/empty cells
                ElseIf Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    If bolValueSet Then
                        If varValue > rngValues(intRow, intCol).Value2 Then varValue = rngValues(intRow, intCol).Value2
                    Else
                        bolValueSet = True
                        varValue = rngValues(intRow, intCol).Value2
                    End If
                End If
            Next intCol
        Next intRow
    End If
    MinAIf = varValue
End Function
 
Public Function MaxAIf(rngEvaluate As Range, _
    strCondition As String, _
    Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim bolValueSet         As Boolean
    Dim intRow              As Integer, _
    intCol              As Integer
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    bolValueSet = False
    If Not RangesOK(rngEvaluate, rngValues) Then
         'Return an error value
        varValue = "Error in range selection"
    Else
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Not (IsNumeric(rngValues(intRow, intCol).Text) Or IsDate(rngValues(intRow, intCol).Text)) Then
                    ' Ignore non-numeric/empty cells
                ElseIf Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    If bolValueSet Then
                        If varValue < rngValues(intRow, intCol).Value2 Then varValue = rngValues(intRow, intCol).Value2
                    Else
                        bolValueSet = True
                        varValue = rngValues(intRow, intCol).Value2
                    End If
                End If
            Next intCol
        Next intRow
    End If
    MaxAIf = varValue
End Function


Public Function AverageAIf(rngEvaluate As Range, _
    strCondition As String, _
    Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim dblSum              As Double
    Dim lngCount            As Long
    Dim intRow              As Integer, _
    intCol              As Integer
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    If Not RangesOK(rngEvaluate, rngValues) Then
         'Return an error value
        varValue = "Error in range selection"
    Else
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Not (IsNumeric(rngValues(intRow, intCol).Text) Or IsDate(rngValues(intRow, intCol).Text)) Then
                    ' Ignore non-numeric/empty cells
                ElseIf Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    dblSum = dblSum + rngValues(intRow, intCol).Value2
                    lngCount = lngCount + 1
                End If
            Next intCol
        Next intRow
        varValue = dblSum / lngCount
    End If
    AverageAIf = varValue
End Function

Display More

A9192Shark · Jul 10th 2006

Re: maxif function in vba - additional functions

MisterBates,

The code does not deal with areas but simply checks that the two ranges have the same number of columns and rows, that is they are identically sized. If a range has multiple areas then the function will only check the first area of each range as this is teh default area returned.

My use of the functions was always on contiguous cells- ie ranges with only 1 area.

It might be worth trying to write a generic function that has a parameter passed that selects the actual function and comparison to be made. This would use a select statement based on that parameter.

Note that the code proposed by Andy Pope would be much more efficient and if I get time I will write a generic one based on his approach.

Cheers,

Alan.

MisterBates · Jul 10th 2006

Re: maxif function in vba - additional functions

Hi, and thanks for the reply.

Now I understand why you used 'or' in your check for areas.

On the code suggested by Andy Pope, this would be a great speedup for a MaxIf function that only had to deal with positive numbers (e.g. returning maximum of a range of dates), but it has the problem described in http://www.excelforum.com/showthread.php?t=376268 when it comes to negative values. There's a similar problem with MinIf using that method. And of course the condition part of the formulae doesn't use the same conditions as CountIf and SumIf.

I think I like your code better (even if it is slower). And it's possible to avoid some overhead by testing the rngEvaluate with Countif first to see if any cells meet the condition, avoiding the iterations if none do, as in:

Code

' Modified code --- UNTESTED!!!
Public Function MinIf(rngEvaluate As Range, _ 
    strCondition As String, _ 
    Optional rngValues As Range = Nothing) As Variant 
    Dim varValue            As Variant 
    Dim bolValueSet         As Boolean 
    Dim intRow              As Integer, _ 
    intCol              As Integer 
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate 
    bolValueSet = False 
    If Not RangesOK(rngEvaluate, rngValues) Then 
         'Return an error value
        varValue = "Error in range selection" 
    Else 
         'If the ranges are not identically sized can not get this far!
        If Application.CountIf(rngEvaluate, strCondition) > 0 Then 
            For intRow = 1 To rngEvaluate.Rows.Count 
                For intCol = 1 To rngEvaluate.Columns.Count 
                    If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then 
                        If bolValueSet Then 
                            If varValue > rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol) 
                        Else 
                            bolValueSet = True 
                            varValue = rngValues(intRow, intCol) 
                        End If 
                    End If 
                Next intCol 
            Next intRow 
        End if
    End If 
    MinIf = varValue 
End Function

Display More

BTW, I built on your code and added AverageIf, plus a few functions for Sum, Min, Max and Average that will ignore non-numeric values (all named with "..AIf" at the end).

Thanks again for the basis!!

onequestion · Jul 29th 2013

Re: maxif function in vba

Quote from A9192Shark;132949

Mienz,

After wanting these functions for years I finally wrote these last month. They use the same structure as SumIf and CountIf functions (actually they use these functions to evaluate the function.)

HTH,

Alan.

Code

Option Explicit


'These functions have been developed by Alan Forster on 27th September 2004.
'After years of desire he has actually written them!
'The functions use the same evaluation methods as the CountIf and SumIf functions


Public Function MinIf(rngEvaluate As Range, _
                      strCondition As String, _
                      Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim bolValueSet         As Boolean
    Dim intRow              As Integer, _
        intCol              As Integer
        
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    bolValueSet = False
    If Not RangesOK(rngEvaluate, rngValues) Then
        'Return an error value
        varValue = "Error in range selection"
      Else
        'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    If bolValueSet Then
                        If varValue > rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol)
                      Else
                        bolValueSet = True
                        varValue = rngValues(intRow, intCol)
                    End If
                End If
            Next intCol
        Next intRow
    End If
    MinIf = varValue
End Function


Public Function MaxIf(rngEvaluate As Range, _
                      strCondition As String, _
                      Optional rngValues As Range = Nothing) As Variant
    Dim varValue            As Variant
    Dim bolValueSet         As Boolean
    Dim intRow              As Integer, _
        intCol              As Integer
        
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate
    bolValueSet = False
    If Not RangesOK(rngEvaluate, rngValues) Then
        'Return an error value
        varValue = "Error in range selection"
      Else
        'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count
            For intCol = 1 To rngEvaluate.Columns.Count
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then
                    If bolValueSet Then
                        If varValue < rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol)
                      Else
                        bolValueSet = True
                        varValue = rngValues(intRow, intCol)
                    End If
                End If
            Next intCol
        Next intRow
    End If
    MaxIf = varValue
End Function


Private Function RangesOK(rng1 As Range, rng2 As Range) As Boolean
    Dim bolAreas    As Boolean, _
        bolSize     As Boolean
    bolAreas = (rng1.Areas.Count = 1) Or (rng2.Areas.Count = 1)
    bolSize = (rng1.Rows.Count = rng2.Rows.Count) And _
              (rng1.Columns.Count = rng2.Columns.Count)
    RangesOK = bolAreas And bolSize
End Function

Display More

Hi Alan,

Can you perhaps adapt the code to be able to have tow condidtions for the maximum. That is, I'd like to have something like this:
Maxif(rng1, condition1, rng2, condition2, rngValues)
where rngValues could be the same as rng1 or rng2.

Best regards
Seb

**pike** · Jul 30th 2013

Re: maxif function in vba

Hj onequestion
Welcome to the Forum
Can you please start your own thread and reference this one if relevant .

maxif function in vba

Participate now!

Share