Ozgrid, Experts in Microsoft Excel Spreadsheets

Sum Values In Excel Meeting Up To 5 Criteria/Conditions

| | Information Helpful? Why Not Donate.

TRY OUT: Smart-VBA | Code-VBA | Analyzer-XL | Downloader-XL | Trader-XL| More Free Downloads.. Best Value: Finance Templates Bundle

Got any Excel Questions? Excel Help .

NEW & FREE! Excel Custom Functions Add-in (has this and many other functions within) | Excel List to Table Creator Create an classic Excel table from data in a single column list. | Fill Blanks Excel Add-in Fill blanks in a list with the cell above

Multiple Condition/criteria sum function for excel

This Custom Function for pre Excel 2007. If you have Excel 2007, use SUMIFS. It allows you to nominate up to 5 conditions/criteria to be met in corresponding columns. As with nearly all Custom Functions for Excel, it's pays to keep the range used as small as possible. It also pays to use the 1st criteria (Criteria1) as an equal to. E.g 3 OR cat

Function SumByCriteria(Sum_Range As Range, Criteria1, Criteria1Range As Range, _
    Criteria2 As String, Criteria2Range As Range, Optional Criteria3 As String, _
    Optional Criteria3Range As Range, Optional Criteria4 As String, _
    Optional Criteria4Range As Range, Optional Criteria5 As String, _
    Optional Criteria5Range As Range) As Long
   
Dim lLoopStop As Long, lLoop As Long, rRange As Range, lRow As Long
Dim sTotal As Single, bVal1 As Boolean, bVal2 As Boolean, bVal3 As Boolean
Dim bVal4 As Boolean, bVal5 As Boolean, bVal1b As Boolean, bVal2b As Boolean, bVal3b As Boolean
Dim bVal4b As Boolean, bVal5b As Boolean, lCriteriaUsed As Long
Dim strCriteria1 As String, strCriteria2 As String, strCriteria3 As String, strCriteria4 As String, strCriteria5 As String
Dim rCell As Range

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''Written by ozgrid.com''''''''''''''''''''''''''''''''''''''
'Sums Values in Sum_Range when up to 5 conditions are met in corresponding cells.
'As with nearly all Custom Functions for Excel, it's pays to keep the range used as _
    small as possible. It also pays to use the 1st criteria (Criteria1) as an equal to. E.g 3 OR cat
''IF YOU HAVE 2007 USE SUMIFS
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


    lLoopStop = WorksheetFunction.CountIf(Criteria1Range, Criteria1)

    bVal3 = Not Criteria3Range Is Nothing
    bVal4 = Not Criteria4Range Is Nothing
    bVal5 = Not Criteria5Range Is Nothing
    
    If bVal5 = False Then lCriteriaUsed = 4
    If bVal4 = False Then lCriteriaUsed = 3
    If bVal3 = False Then lCriteriaUsed = 2
    
    strCriteria1 = Criteria1
    strCriteria2 = Criteria2
    strCriteria3 = Criteria3
    strCriteria4 = Criteria4
    strCriteria5 = Criteria5
    
    If InStr(1, Criteria1, ">") + InStr(1, Criteria1, "<") = 0 Then
    
            Set rRange = Criteria1Range(1, 1)
                For lLoop = 1 To lLoopStop 'Fast loop
                    Set rRange = Criteria1Range.Find(Criteria1, rRange, _
                            xlFormulas, xlWhole, xlByRows, xlNext, False)
                    lRow = rRange.Row
                        
                        'Criteria 5 evaluation
                    If bVal5 = True Then
                        If InStr(1, Criteria5, ">") + InStr(1, Criteria5, "<") = 0 Then
                              Criteria5 = Replace(Criteria5, "=", "")
                                 If IsNumeric(Criteria5) Then
                                    bVal5b = Criteria5Range(lRow, 1) = Val(Criteria5)
                                 Else
                                    bVal5b = Criteria5Range(lRow, 1) = Criteria5
                                 End If
                        ElseIf InStr(1, Criteria5, ">=") <> 0 Then
                             Criteria5 = Replace(Criteria5, ">=", "")
                             bVal5b = Val(Criteria5) >= Criteria5Range(lRow, 1)
                        ElseIf InStr(1, Criteria5, "<=") <> 0 Then
                             Criteria5 = Replace(Criteria5, "<=", "")
                             bVal5b = Val(Criteria5) <= Criteria5Range(lRow, 1)
                        ElseIf InStr(1, Criteria5, ">") <> 0 Then
                             Criteria5 = Replace(Criteria5, ">", "")
                             bVal5b = Val(Criteria5) > Criteria5Range(lRow, 1)
                        Else
                             Criteria5 = Replace(Criteria5, "<", "")
                             bVal5b = Val(Criteria5) < Criteria5Range(lRow, 1)
                        End If
                    End If
                        
                    If bVal4 = True Then
                        'Criteria 4 evaluation
                        If InStr(1, Criteria4, ">") + InStr(1, Criteria4, "<") = 0 Then
                              Criteria4 = Replace(Criteria4, "=", "")
                                 If IsNumeric(Criteria4) Then
                                    bVal4b = Criteria4Range(lRow, 1) = Val(Criteria4)
                                 Else
                                    bVal4b = Criteria4Range(lRow, 1) = Criteria4
                                 End If
                        ElseIf InStr(1, Criteria4, ">=") <> 0 Then
                             Criteria4 = Replace(Criteria4, ">=", "")
                             bVal4b = Criteria4Range(lRow, 1) >= Val(Criteria4)
                        ElseIf InStr(1, Criteria4, "<=") <> 0 Then
                             Criteria4 = Replace(Criteria4, "<=", "")
                             bVal4b = Criteria4Range(lRow, 1) <= Val(Criteria4)
                        ElseIf InStr(1, Criteria4, ">") <> 0 Then
                             Criteria4 = Replace(Criteria4, ">", "")
                             bVal4b = Criteria4Range(lRow, 1) > Val(Criteria4)
                        Else
                             Criteria4 = Replace(Criteria4, "<", "")
                             bVal4b = Criteria4Range(lRow, 1) < Val(Criteria4)
                        End If
                    End If
                    
                    If bVal3 = True Then
                        'Criteria 3 evaluation
                        If InStr(1, Criteria3, ">") + InStr(1, Criteria3, "<") = 0 Then
                              Criteria3 = Replace(Criteria3, "=", "")
                                 If IsNumeric(Criteria3) Then
                                    bVal3b = Criteria3Range(lRow, 1) = Val(Criteria3)
                                 Else
                                    bVal3b = Criteria3Range(lRow, 1) = Criteria3
                                 End If
                        ElseIf InStr(1, Criteria3, ">=") <> 0 Then
                             Criteria3 = Replace(Criteria3, ">=", "")
                             bVal3b = Criteria3Range(lRow, 1) >= Val(Criteria3)
                        ElseIf InStr(1, Criteria3, "<=") <> 0 Then
                             Criteria3 = Replace(Criteria3, "<=", "")
                             bVal3b = Criteria3Range(lRow, 1) <= Val(Criteria3)
                        ElseIf InStr(1, Criteria3, ">") <> 0 Then
                             Criteria3 = Replace(Criteria3, ">", "")
                             bVal3b = Criteria3Range(lRow, 1) > Val(Criteria3)
                        Else
                             Criteria3 = Replace(Criteria3, "<", "")
                           If bVal3 = True Then bVal3b = Criteria3Range(lRow, 1) < Val(Criteria3)
                        End If
                    End If
                        
                        'Criteria 2 evaluation
                        If InStr(1, Criteria2, ">") + InStr(1, Criteria2, "<") = 0 Then
                              Criteria2 = Replace(Criteria2, "=", "")
                                 If IsNumeric(Criteria2) Then
                                    bVal2b = Criteria2Range(lRow, 1) = Val(Criteria2)
                                 Else
                                    bVal2b = Criteria2Range(lRow, 1) = Criteria2
                                 End If
                        ElseIf InStr(1, Criteria2, ">=") <> 0 Then
                             Criteria2 = Replace(Criteria2, ">=", "")
                             bVal2b = Criteria2Range(lRow, 1) >= Val(Criteria2)
                        ElseIf InStr(1, Criteria2, "<=") <> 0 Then
                             Criteria2 = Replace(Criteria2, "<=", "")
                             bVal2b = Criteria2Range(lRow, 1) <= Val(Criteria2)
                        ElseIf InStr(1, Criteria2, ">") <> 0 Then
                             Criteria2 = Replace(Criteria2, ">", "")
                            bVal2b = Criteria2Range(lRow, 1) > Val(Criteria2)
                        Else
                             Criteria2 = Replace(Criteria2, "<", "")
                           bVal2b = Criteria2Range(lRow, 1) < Val(Criteria2)
                        End If
                        
                         'Criteria 1 evaluation
                        If InStr(1, Criteria1, ">") + InStr(1, Criteria1, "<") = 0 Then
                              Criteria1 = Replace(Criteria1, "=", "")
                                 If IsNumeric(Criteria1) Then
                                    bVal1b = Criteria1Range(lRow, 1) = Val(Criteria1)
                                 Else
                                    bVal1b = Criteria1Range(lRow, 1) = Criteria1
                                 End If
                        ElseIf InStr(1, Criteria1, ">=") <> 0 Then
                             Criteria1 = Replace(Criteria1, ">=", "")
                             bVal1b = Criteria1Range(lRow, 1) >= Val(Criteria1)
                        ElseIf InStr(1, Criteria1, "<=") <> 0 Then
                             Criteria1 = Replace(Criteria1, "<=", "")
                             bVal1b = Criteria1Range(lRow, 1) <= Val(Criteria1)
                        ElseIf InStr(1, Criteria1, ">") <> 0 Then
                             Criteria1 = Replace(Criteria1, ">", "")
                            bVal1b = Criteria1Range(lRow, 1) > Val(Criteria1)
                        Else
                             Criteria1 = Replace(Criteria1, "<", "")
                           bVal1b = Criteria1Range(lRow, 1) < Val(Criteria1)
                        End If
                        
                           
                        If lCriteriaUsed > 4 Then
                           If bVal5b And bVal4b And bVal3b And bVal2b And bVal1b Then
                                sTotal = WorksheetFunction.Sum(Sum_Range(lRow, 1), sTotal)
                            End If
                        ElseIf lCriteriaUsed > 3 Then
                            If bVal4b And bVal3b And bVal2b And bVal1b Then
                                sTotal = WorksheetFunction.Sum(Sum_Range(lRow, 1), sTotal)
                            End If
                        ElseIf lCriteriaUsed > 2 Then
                            If bVal3b And bVal2 And bVal1b Then
                                sTotal = WorksheetFunction.Sum(Sum_Range(lRow, 1), sTotal)
                            End If
                        ElseIf bVal2b And bVal1b Then
                              sTotal = WorksheetFunction.Sum(Sum_Range(lRow, 1), sTotal)
                        End If
                        
                        
                            Criteria1 = strCriteria1
                            Criteria2 = strCriteria2
                            Criteria3 = strCriteria3
                            Criteria4 = strCriteria4
                            Criteria5 = strCriteria5
              Next lLoop
            
             Else 'Slower loop through ALL rows
                    
                    For Each rCell In Criteria1Range
                        lRow = rCell.Row
                            'Criteria 5 evaluation
                            If bVal5 = True Then
                                If InStr(1, Criteria5, ">") + InStr(1, Criteria5, "<") = 0 Then
                                      Criteria5 = Replace(Criteria5, "=", "")
                                         If IsNumeric(Criteria5) Then
                                            bVal5b = Criteria5Range(lRow, 1) = Val(Criteria5)
                                         Else
                                            bVal5b = Criteria5Range(lRow, 1) = Criteria5
                                         End If
                                ElseIf InStr(1, Criteria5, ">=") <> 0 Then
                                     Criteria5 = Replace(Criteria5, ">=", "")
                                     bVal5b = Criteria5Range(lRow, 1) >= Val(Criteria5)
                                ElseIf InStr(1, Criteria5, "<=") <> 0 Then
                                     Criteria5 = Replace(Criteria5, "<=", "")
                                     bVal5b = Criteria5Range(lRow, 1) <= Val(Criteria5)
                                ElseIf InStr(1, Criteria5, ">") <> 0 Then
                                     Criteria5 = Replace(Criteria5, ">", "")
                                     bVal5b = Criteria5Range(lRow, 1) > Val(Criteria5)
                                Else
                                     Criteria5 = Replace(Criteria5, "<", "")
                                     bVal5b = Criteria5Range(lRow, 1) < Val(Criteria5)
                                End If
                            End If
                                
                            If bVal4 = True Then
                                'Criteria 4 evaluation
                                If InStr(1, Criteria4, ">") + InStr(1, Criteria4, "<") = 0 Then
                                      Criteria4 = Replace(Criteria4, "=", "")
                                         If IsNumeric(Criteria4) Then
                                            bVal4b = Criteria4Range(lRow, 1) = Val(Criteria4)
                                         Else
                                            bVal4b = Criteria4Range(lRow, 1) = Criteria4
                                         End If
                                ElseIf InStr(1, Criteria4, ">=") <> 0 Then
                                     Criteria4 = Replace(Criteria4, ">=", "")
                                     bVal4b = Criteria4Range(lRow, 1) >= Val(Criteria4)
                                ElseIf InStr(1, Criteria4, "<=") <> 0 Then
                                     Criteria4 = Replace(Criteria4, "<=", "")
                                     bVal4b = Criteria4Range(lRow, 1) <= Val(Criteria4)
                                ElseIf InStr(1, Criteria4, ">") <> 0 Then
                                     Criteria4 = Replace(Criteria4, ">", "")
                                     bVal4b = Criteria4Range(lRow, 1) > Val(Criteria4)
                                Else
                                     Criteria4 = Replace(Criteria4, "<", "")
                                     bVal4b = Criteria4Range(lRow, 1) < Val(Criteria4)
                                End If
                            End If
                            
                            If bVal3 = True Then
                                'Criteria 3 evaluation
                                If InStr(1, Criteria3, ">") + InStr(1, Criteria3, "<") = 0 Then
                                      Criteria3 = Replace(Criteria3, "=", "")
                                         If IsNumeric(Criteria3) Then
                                            bVal3b = Criteria3Range(lRow, 1) = Val(Criteria3)
                                         Else
                                            bVal3b = Criteria3Range(lRow, 1) = Criteria3
                                         End If
                                ElseIf InStr(1, Criteria3, ">=") <> 0 Then
                                     Criteria3 = Replace(Criteria3, ">=", "")
                                     bVal3b = Criteria3Range(lRow, 1) >= Val(Criteria3)
                                ElseIf InStr(1, Criteria3, "<=") <> 0 Then
                                     Criteria3 = Replace(Criteria3, "<=", "")
                                     bVal3b = Criteria3Range(lRow, 1) <= Val(Criteria3)
                                ElseIf InStr(1, Criteria3, ">") <> 0 Then
                                     Criteria3 = Replace(Criteria3, ">", "")
                                     bVal3b = Criteria3Range(lRow, 1) > Val(Criteria3)
                                Else
                                     Criteria3 = Replace(Criteria3, "<", "")
                                   If bVal3 = True Then bVal3b = Criteria3Range(lRow, 1) < Val(Criteria3)
                                End If
                            End If
                                
                                'Criteria 2 evaluation
                                If InStr(1, Criteria2, ">") + InStr(1, Criteria2, "<") = 0 Then
                                      Criteria2 = Replace(Criteria2, "=", "")
                                         If IsNumeric(Criteria2) Then
                                            bVal2b = Criteria2Range(lRow, 1) = Val(Criteria2)
                                         Else
                                            bVal2b = Criteria2Range(lRow, 1) = Criteria2
                                         End If
                                ElseIf InStr(1, Criteria2, ">=") <> 0 Then
                                     Criteria2 = Replace(Criteria2, ">=", "")
                                     bVal2b = Criteria2Range(lRow, 1) >= Val(Criteria2)
                                ElseIf InStr(1, Criteria2, "<=") <> 0 Then
                                     Criteria2 = Replace(Criteria2, "<=", "")
                                     bVal2b = Criteria2Range(lRow, 1) <= Val(Criteria2)
                                ElseIf InStr(1, Criteria2, ">") <> 0 Then
                                     Criteria2 = Replace(Criteria2, ">", "")
                                    bVal2b = Criteria2Range(lRow, 1) > Val(Criteria2)
                                Else
                                     Criteria2 = Replace(Criteria2, "<", "")
                                   bVal2b = Criteria2Range(lRow, 1) < Val(Criteria2)
                                End If
                                
                                 'Criteria 1 evaluation
                                If InStr(1, Criteria1, ">") + InStr(1, Criteria1, "<") = 0 Then
                                      Criteria1 = Replace(Criteria1, "=", "")
                                         If IsNumeric(Criteria1) Then
                                            bVal1b = Criteria1Range(lRow, 1) = Val(Criteria1)
                                         Else
                                            bVal1b = Criteria1Range(lRow, 1) = Criteria1
                                         End If
                                ElseIf InStr(1, Criteria1, ">=") <> 0 Then
                                     Criteria1 = Replace(Criteria1, ">=", "")
                                     bVal1b = Criteria1Range(lRow, 1) >= Val(Criteria1)
                                ElseIf InStr(1, Criteria1, "<=") <> 0 Then
                                     Criteria1 = Replace(Criteria1, "<=", "")
                                     bVal1b = Criteria1Range(lRow, 1) <= Val(Criteria1)
                                ElseIf InStr(1, Criteria1, ">") <> 0 Then
                                     Criteria1 = Replace(Criteria1, ">", "")
                                    bVal1b = Criteria1Range(lRow, 1) > Val(Criteria1)
                                Else
                                     Criteria1 = Replace(Criteria1, "<", "")
                                   bVal1b = Criteria1Range(lRow, 1) < Val(Criteria1)
                                End If
                                   
                                If lCriteriaUsed > 4 Then
                                   If bVal5b And bVal4b And bVal3b And bVal2b And bVal1b Then
                                        sTotal = WorksheetFunction.Sum(Sum_Range(lRow, 1), sTotal)
                                    End If
                                ElseIf lCriteriaUsed > 3 Then
                                    If bVal4b And bVal3b And bVal2b And bVal1b Then
                                        sTotal = WorksheetFunction.Sum(Sum_Range(lRow, 1), sTotal)
                                    End If
                                ElseIf lCriteriaUsed > 2 Then
                                    If bVal3b And bVal2 And bVal1b Then
                                        sTotal = WorksheetFunction.Sum(Sum_Range(lRow, 1), sTotal)
                                    End If
                                ElseIf bVal2b And bVal1b Then
                                      sTotal = WorksheetFunction.Sum(Sum_Range(lRow, 1), sTotal)
                                End If
                                    Criteria1 = strCriteria1
                                    Criteria2 = strCriteria2
                                    Criteria3 = strCriteria3
                                    Criteria4 = strCriteria4
                                    Criteria5 = strCriteria5
                    Next rCell
        End If
            
    SumByCriteria = sTotal
End Function

Example usage;

=SumByCriteria(A1:A21,"cat",C1:C21,"furry",E1:E21,"fluffy",G1:G21,"persian",I1:I21)

Note this only uses 4 criteria, not 5. The 1st 2 criteria are mandatory (if you only need 1, use SUMIF) while the last 3 are optional

Excel Dashboard Reports & Excel Dashboard Charts 50% Off

Become an ExcelUser Affiliate & Earn Money

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to [email protected] 31 days after purchase date.


Instant Download and Money Back Guarantee on Most Software

Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!

Add to Google Search Tips FREE Excel Help

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft

GIVE YOURSELF OR YOUR COMPANY 24/7 MICROSOFT EXCEL SUPPORT & QUESTIONS