M
matthias.karl
Hi
I have written a custom function that you can use in Excel prior to
2007. It has the same syntax, but can take just 3 different criteria.
But you could add more as needed.
Hope this helps anybody.
Matthias
'******************************************************************************************
'************* SumIf-Function as in XL-2007
***********************************************
'******************************************************************************************
Function SumIfs(SumRng As Range, Crit1Rng As Range, Criteria1 As
String, Crit2Rng As Range, Criteria2 As String, Crit3Rng As Range,
Criteria3 As String) As Double
'The following parameters are necessary
'SumRng as Range: Range to be summed up
'Crit1Rng as Range: Range where the first criteria is
'Criteria1 As String: String with the criteria for Crit1Rng
'Two more pairs with Range and Criteria
'Returns a value as double
Dim c As Range, ColI As Integer, cnt As Integer, C1Cols As Integer,
C2Cols As Integer, C3Cols As Integer
Dim C1 As Boolean, C2 As Boolean, C3 As Boolean, Is1Date As
Boolean, Is2Date As Boolean, Is3Date As Boolean
Dim C1RVal As Variant, C2RVal As Variant, C3RVal As Variant
cnt = 1
C1 = False
C2 = False
C3 = False
Is1Date = False
Is2Date = False
Is3Date = False
ColI = SumRng.Column + 1
For Each c In SumRng
C1Cols = ColI - c.Column
C2Cols = ColI - c.Column
C3Cols = ColI - c.Column
'Criteria1
C1RVal = Crit1Rng.Value(cnt, C1Cols)
If VarType(C1RVal) = 7 Then
Is1Date = True
End If
Select Case True
Case InStr(Left(Criteria1, 2), "<=") > 0
If Is1Date Then
If C1RVal <= Int(Right(Criteria1, Len(Criteria1) - 2))
Then
C1 = True
End If
Else
If C1RVal <= Right(Criteria1, Len(Criteria1) - 2) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 2), ">=") > 0
If Is1Date Then
If C1RVal >= Int(Right(Criteria1, Len(Criteria1) - 2))
Then
C1 = True
End If
Else
If C1RVal >= Right(Criteria1, Len(Criteria1) - 2) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 2), "<>") > 0
If Is1Date Then
If C1RVal <> Int(Right(Criteria1, Len(Criteria1) - 2))
Then
C1 = True
End If
Else
If C1RVal <> Right(Criteria1, Len(Criteria1) - 2) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 1), "<") > 0
If Is1Date Then
If C1RVal < Int(Right(Criteria1, Len(Criteria1) - 1))
Then
C1 = True
End If
Else
If C1RVal < Right(Criteria1, Len(Criteria1) - 1) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 1), ">") > 0
If Is1Date Then
If C1RVal > Int(Right(Criteria1, Len(Criteria1) - 1))
Then
C1 = True
End If
Else
If C1RVal > Right(Criteria1, Len(Criteria1) - 1) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 1), "=") > 0
If Is1Date Then
If C1RVal = Int(Right(Criteria1, Len(Criteria1) - 1))
Then
C1 = True
End If
Else
If C1RVal = Right(Criteria1, Len(Criteria1) - 1) Then
C1 = True
End If
End If
Case Else
If C1RVal = Criteria1 Then
C1 = True
End If
End Select
'Criteria2
C2RVal = Crit2Rng.Value(cnt, C2Cols)
If VarType(C2RVal) = 7 Then
Is2Date = True
End If
Select Case True
Case InStr(Left(Criteria2, 2), "<=") > 0
If Is2Date Then
If C2RVal <= Int(Right(Criteria2, Len(Criteria2) - 2))
Then
C2 = True
End If
Else
If C2RVal <= Right(Criteria2, Len(Criteria2) - 2) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 2), ">=") > 0
If Is2Date Then
If C2RVal >= Int(Right(Criteria2, Len(Criteria2) - 2))
Then
C2 = True
End If
Else
If C2RVal >= Right(Criteria2, Len(Criteria2) - 2) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 2), "<>") > 0
If Is2Date Then
If C2RVal <> Int(Right(Criteria2, Len(Criteria2) - 2))
Then
C2 = True
End If
Else
If C2RVal <> Right(Criteria2, Len(Criteria2) - 2) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 1), "<") > 0
If Is2Date Then
If C2RVal < Int(Right(Criteria2, Len(Criteria2) - 1))
Then
C2 = True
End If
Else
If C2RVal < Right(Criteria2, Len(Criteria2) - 1) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 1), ">") > 0
If Is2Date Then
If C2RVal > Int(Right(Criteria2, Len(Criteria2) - 1))
Then
C2 = True
End If
Else
If C2RVal > Right(Criteria2, Len(Criteria2) - 1) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 1), "=") > 0
If Is2Date Then
If C2RVal = Int(Right(Criteria2, Len(Criteria2) - 1))
Then
C2 = True
End If
Else
If C2RVal = Right(Criteria2, Len(Criteria2) - 1) Then
C2 = True
End If
End If
Case Else
If C2RVal = Criteria2 Then
C2 = True
End If
End Select
Is2Date = False
'Criteria3
C3RVal = Crit3Rng.Value(cnt, C3Cols)
If VarType(C3RVal) = 7 Then
Is3Date = True
End If
Select Case True
Case InStr(Left(Criteria3, 2), "<=") > 0
If Is3Date Then
If C3RVal <= Int(Right(Criteria3, Len(Criteria3) - 2))
Then
C3 = True
End If
Else
If C3RVal <= Right(Criteria3, Len(Criteria3) - 2) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 2), ">=") > 0
If Is3Date Then
If C3RVal >= Int(Right(Criteria3, Len(Criteria3) - 2))
Then
C3 = True
End If
Else
If C3RVal >= Right(Criteria3, Len(Criteria3) - 2) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 2), "<>") > 0
If Is3Date Then
If C3RVal <> Int(Right(Criteria3, Len(Criteria3) - 2))
Then
C3 = True
End If
Else
If C3RVal <> Right(Criteria3, Len(Criteria3) - 2) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 1), "<") > 0
If Is3Date Then
If C3RVal < Int(Right(Criteria3, Len(Criteria3) - 1))
Then
C3 = True
End If
Else
If C3RVal < Right(Criteria3, Len(Criteria3) - 1) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 1), ">") > 0
If Is3Date Then
If C3RVal > Int(Right(Criteria3, Len(Criteria3) - 1))
Then
C3 = True
End If
Else
If C3RVal > Right(Criteria3, Len(Criteria3) - 1) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 1), "=") > 0
If Is3Date Then
If C3RVal = Int(Right(Criteria3, Len(Criteria3) - 1))
Then
C3 = True
End If
Else
If C3RVal = Right(Criteria3, Len(Criteria3) - 1) Then
C3 = True
End If
End If
Case Else
If C3RVal = Criteria3 Then
C3 = True
End If
End Select
Is3Date = False
If C1 = True And C2 = True And C3 = True Then 'If Crit1, Crit2
and Crit3 are true, then sum the cell
SumIfs = SumIfs + c.Value
End If
C1 = False
C2 = False
C3 = False
cnt = cnt + 1
Next
End Function
I have written a custom function that you can use in Excel prior to
2007. It has the same syntax, but can take just 3 different criteria.
But you could add more as needed.
Hope this helps anybody.
Matthias
'******************************************************************************************
'************* SumIf-Function as in XL-2007
***********************************************
'******************************************************************************************
Function SumIfs(SumRng As Range, Crit1Rng As Range, Criteria1 As
String, Crit2Rng As Range, Criteria2 As String, Crit3Rng As Range,
Criteria3 As String) As Double
'The following parameters are necessary
'SumRng as Range: Range to be summed up
'Crit1Rng as Range: Range where the first criteria is
'Criteria1 As String: String with the criteria for Crit1Rng
'Two more pairs with Range and Criteria
'Returns a value as double
Dim c As Range, ColI As Integer, cnt As Integer, C1Cols As Integer,
C2Cols As Integer, C3Cols As Integer
Dim C1 As Boolean, C2 As Boolean, C3 As Boolean, Is1Date As
Boolean, Is2Date As Boolean, Is3Date As Boolean
Dim C1RVal As Variant, C2RVal As Variant, C3RVal As Variant
cnt = 1
C1 = False
C2 = False
C3 = False
Is1Date = False
Is2Date = False
Is3Date = False
ColI = SumRng.Column + 1
For Each c In SumRng
C1Cols = ColI - c.Column
C2Cols = ColI - c.Column
C3Cols = ColI - c.Column
'Criteria1
C1RVal = Crit1Rng.Value(cnt, C1Cols)
If VarType(C1RVal) = 7 Then
Is1Date = True
End If
Select Case True
Case InStr(Left(Criteria1, 2), "<=") > 0
If Is1Date Then
If C1RVal <= Int(Right(Criteria1, Len(Criteria1) - 2))
Then
C1 = True
End If
Else
If C1RVal <= Right(Criteria1, Len(Criteria1) - 2) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 2), ">=") > 0
If Is1Date Then
If C1RVal >= Int(Right(Criteria1, Len(Criteria1) - 2))
Then
C1 = True
End If
Else
If C1RVal >= Right(Criteria1, Len(Criteria1) - 2) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 2), "<>") > 0
If Is1Date Then
If C1RVal <> Int(Right(Criteria1, Len(Criteria1) - 2))
Then
C1 = True
End If
Else
If C1RVal <> Right(Criteria1, Len(Criteria1) - 2) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 1), "<") > 0
If Is1Date Then
If C1RVal < Int(Right(Criteria1, Len(Criteria1) - 1))
Then
C1 = True
End If
Else
If C1RVal < Right(Criteria1, Len(Criteria1) - 1) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 1), ">") > 0
If Is1Date Then
If C1RVal > Int(Right(Criteria1, Len(Criteria1) - 1))
Then
C1 = True
End If
Else
If C1RVal > Right(Criteria1, Len(Criteria1) - 1) Then
C1 = True
End If
End If
Case InStr(Left(Criteria1, 1), "=") > 0
If Is1Date Then
If C1RVal = Int(Right(Criteria1, Len(Criteria1) - 1))
Then
C1 = True
End If
Else
If C1RVal = Right(Criteria1, Len(Criteria1) - 1) Then
C1 = True
End If
End If
Case Else
If C1RVal = Criteria1 Then
C1 = True
End If
End Select
'Criteria2
C2RVal = Crit2Rng.Value(cnt, C2Cols)
If VarType(C2RVal) = 7 Then
Is2Date = True
End If
Select Case True
Case InStr(Left(Criteria2, 2), "<=") > 0
If Is2Date Then
If C2RVal <= Int(Right(Criteria2, Len(Criteria2) - 2))
Then
C2 = True
End If
Else
If C2RVal <= Right(Criteria2, Len(Criteria2) - 2) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 2), ">=") > 0
If Is2Date Then
If C2RVal >= Int(Right(Criteria2, Len(Criteria2) - 2))
Then
C2 = True
End If
Else
If C2RVal >= Right(Criteria2, Len(Criteria2) - 2) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 2), "<>") > 0
If Is2Date Then
If C2RVal <> Int(Right(Criteria2, Len(Criteria2) - 2))
Then
C2 = True
End If
Else
If C2RVal <> Right(Criteria2, Len(Criteria2) - 2) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 1), "<") > 0
If Is2Date Then
If C2RVal < Int(Right(Criteria2, Len(Criteria2) - 1))
Then
C2 = True
End If
Else
If C2RVal < Right(Criteria2, Len(Criteria2) - 1) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 1), ">") > 0
If Is2Date Then
If C2RVal > Int(Right(Criteria2, Len(Criteria2) - 1))
Then
C2 = True
End If
Else
If C2RVal > Right(Criteria2, Len(Criteria2) - 1) Then
C2 = True
End If
End If
Case InStr(Left(Criteria2, 1), "=") > 0
If Is2Date Then
If C2RVal = Int(Right(Criteria2, Len(Criteria2) - 1))
Then
C2 = True
End If
Else
If C2RVal = Right(Criteria2, Len(Criteria2) - 1) Then
C2 = True
End If
End If
Case Else
If C2RVal = Criteria2 Then
C2 = True
End If
End Select
Is2Date = False
'Criteria3
C3RVal = Crit3Rng.Value(cnt, C3Cols)
If VarType(C3RVal) = 7 Then
Is3Date = True
End If
Select Case True
Case InStr(Left(Criteria3, 2), "<=") > 0
If Is3Date Then
If C3RVal <= Int(Right(Criteria3, Len(Criteria3) - 2))
Then
C3 = True
End If
Else
If C3RVal <= Right(Criteria3, Len(Criteria3) - 2) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 2), ">=") > 0
If Is3Date Then
If C3RVal >= Int(Right(Criteria3, Len(Criteria3) - 2))
Then
C3 = True
End If
Else
If C3RVal >= Right(Criteria3, Len(Criteria3) - 2) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 2), "<>") > 0
If Is3Date Then
If C3RVal <> Int(Right(Criteria3, Len(Criteria3) - 2))
Then
C3 = True
End If
Else
If C3RVal <> Right(Criteria3, Len(Criteria3) - 2) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 1), "<") > 0
If Is3Date Then
If C3RVal < Int(Right(Criteria3, Len(Criteria3) - 1))
Then
C3 = True
End If
Else
If C3RVal < Right(Criteria3, Len(Criteria3) - 1) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 1), ">") > 0
If Is3Date Then
If C3RVal > Int(Right(Criteria3, Len(Criteria3) - 1))
Then
C3 = True
End If
Else
If C3RVal > Right(Criteria3, Len(Criteria3) - 1) Then
C3 = True
End If
End If
Case InStr(Left(Criteria3, 1), "=") > 0
If Is3Date Then
If C3RVal = Int(Right(Criteria3, Len(Criteria3) - 1))
Then
C3 = True
End If
Else
If C3RVal = Right(Criteria3, Len(Criteria3) - 1) Then
C3 = True
End If
End If
Case Else
If C3RVal = Criteria3 Then
C3 = True
End If
End Select
Is3Date = False
If C1 = True And C2 = True And C3 = True Then 'If Crit1, Crit2
and Crit3 are true, then sum the cell
SumIfs = SumIfs + c.Value
End If
C1 = False
C2 = False
C3 = False
cnt = cnt + 1
Next
End Function