VB and VBA Users Source Code: An Excel SUMIF function with two range criterias
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
An Excel SUMIF function with two range criterias
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, September 03, 2002
Hits:
1646
Category:
Unspecified
Article:
The Excel function SUMIF only allows you to specific and single criteria for the summation. The following code allows you to specify two criterias: Option Explicit Option Compare Text 'Purpose : Copies the selected items in a listview to the clipboard 'Inputs : Range1 The first range to evaluate. ' vCriteria1 The criteria to apply to the first range. ' sEvaluation1 Can be: ' "=" Checks the values of the cells in Range1 are equal to vCriteria1. ' "<" Checks the values of the cells in Range1 are less than vCriteria1. ' "<=" Checks the values of the cells in Range1 are less than or equal to vCriteria1. ' ">=" Checks the values of the cells in Range1 are greater than or equal to vCriteria1. ' Range2 The second range to evaluate. ' vCriteria2 The criteria to apply to the second range. ' sEvaluation2 See sEvaluation1 'Outputs : Returns the sum of the values in SumRange which meet the two criterias 'Author : Andrew Baker 'Date : 04/Sep/2002 'Notes : An extended version of SUMIF which allows you to specify two criterias. 'Revisions : Function SUMIFEX(Range1 As Excel.Range, vCriteria1 As Variant, sEvaluation1 As String, Range2 As Excel.Range, vCriteria2 As Variant, sEvaluation2 As String, SumRange As Excel.Range) As Variant Dim colMatching1 As Collection, colMatching2 As Collection, oCell As Excel.Range Application.Volatile True Set colMatching1 = New Collection: Set colMatching2 = New Collection 'Find the matching values in the first range For Each oCell In Range1 Select Case sEvaluation1 Case "=" If oCell.Value = vCriteria1 Then colMatching1.Add oCell.Value, CStr(oCell.Row) End If Case "<" If oCell.Value < vCriteria1 Then colMatching1.Add oCell.Value, CStr(oCell.Row) End If Case "<=" If oCell.Value <= vCriteria1 Then colMatching1.Add oCell.Value, CStr(oCell.Row) End If Case ">" If oCell.Value > vCriteria1 Then colMatching1.Add oCell.Value, CStr(oCell.Row) End If Case ">=" If oCell.Value >= vCriteria1 Then colMatching1.Add oCell.Value, CStr(oCell.Row) End If End Select Next 'Find the matching values in the second range For Each oCell In Range2 Select Case sEvaluation2 Case "=" If oCell.Value = vCriteria2 Then colMatching2.Add oCell.Value, CStr(oCell.Row) End If Case "<" If oCell.Value < vCriteria2 Then colMatching2.Add oCell.Value, CStr(oCell.Row) End If Case "<=" If oCell.Value <= vCriteria2 Then colMatching2.Add oCell.Value, CStr(oCell.Row) End If Case ">" If oCell.Value > vCriteria2 Then colMatching2.Add oCell.Value, CStr(oCell.Row) End If Case ">=" If oCell.Value >= vCriteria2 Then colMatching2.Add oCell.Value, CStr(oCell.Row) End If End Select Next 'Sum the values which are in both ranges On Error Resume Next For Each oCell In SumRange If Len(colMatching1.Item(CStr(oCell.Row))) = 0 Or Len(colMatching2.Item(CStr(oCell.Row))) = 0 Then Else 'Value is in both ranges SUMIFEX = SUMIFEX + oCell.Value End If Next Set colMatching1 = Nothing: Set colMatching2 = Nothing End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
