Home » excel » excel – How do I write a Clone SUMIF Function in VBA?

excel – How do I write a Clone SUMIF Function in VBA?

Posted by: admin May 14, 2020 Leave a comment

Questions:

Lately, as a means of quenching my curiosity, I’m trying to understand how Native Excel Functions would work if they were written in VBA Language.
One such function I was working on was SUMIF

I was able to write the code to replicate exact functioning of SUMIF only if the criteria was an “Equal to” = Operator. I’m stuck as to how to change the code so as to accommodate other operators such as >=, <= etc.

Here’s what I have developed so far.

Function SUMIF_VBA(Crit_Rng As Range, Condition_U As Variant, Sum_Rng As Range)

R_Offset = Sum_Rng.Row - Crit_Rng.Row
C_Offset = Sum_Rng.Column - Crit_Rng.Column

SUMIF_VBA = 0

For Each Cell In Crit_Rng

If Cell.Value = Condition_U Then
SUMIF_VBA = SUMIF_VBA + Cell.Offset(R_Offset, C_Offset).Value

End If

Next Cell

End Function

As you know SUMIF Dynamically arranges for Operators
Eg:

SUMIF(A:A,>=10,C:C)

This code will automatically calculate the sum of values in C Column, if their corresponding A Column values are greater than or equal to 10.

I wanted to include the same functionality in my SUMIF Code.

Thanks for your help.

How to&Answers:

This is one possibility. It does not use Evaluate as you had requested.

Function SUMIF_VBA(Crit_Rng As Range, Condition_U As Variant, Sum_Rng As Range)

R_Offset = Sum_Rng.Row - Crit_Rng.Row
C_Offset = Sum_Rng.Column - Crit_Rng.Column

SUMIF_VBA = 0

Call ParseCondition(Condition_U, Cond_out, Criteria_out)
For Each Cell In Crit_Rng

SumThis = False
Select Case Cond_out
    Case 3
        If Cell.Value = Criteria_out Then
            SumThis = True
        End If
    Case 5
        If Cell.Value > Criteria_out Then
            SumThis = True
        End If
    Case 7
        If Cell.Value < Criteria_out Then
            SumThis = True
        End If
    Case 8
        If Cell.Value >= Criteria_out Then
            SumThis = True
        End If
    Case 10
        If Cell.Value <= Criteria_out Then
            SumThis = True
        End If
    Case 12
        If Cell.Value <> Criteria_out Then
            SumThis = True
        End If
End Select

If SumThis Then
    SUMIF_VBA = SUMIF_VBA + Cell.Offset(R_Offset, C_Offset).Value
End If

Next Cell

End Function

Private Sub ParseCondition(Cond_in, Cond_out, Criteria_out)

    '* Evaluate the condition and set a unique number on each condition
    Cond_out = 0
    If InStr(Cond_in, "=") Then
      Cond_out = Cond_out + 3
    End If

    If InStr(Cond_in, ">") Then
      Cond_out = Cond_out + 5
    End If

    If InStr(Cond_in, "<") Then
      Cond_out = Cond_out + 7
    End If

    Set SDI = CreateObject("VBScript.RegExp")
    SDI.Pattern = "\d+"  '* keep the number only
    Set Num_out = SDI.Execute(Cond_in)
    Criteria_out = Val(Num_out(0))


End Sub

Answer:

Check out!

Function test_sumif(c_a As Range, c_b As String, c_c As Range)
n = 1

For Each r In c_a

If Application.Evaluate(r.Value & c_b) Then
 test_sumif = test_sumif + c_c(n, 1).Value
End If

n = n + 1
Next

End Function

It is as close to the functionality as the original sumif function. Didn’t handle the optional sumrange part though.

Answer:

Here’s some ideas:

'This function returns the filtered array to the caller, so that it may sum, concat, average or whatever
Private Function GetFilteredArray(leftArgRange As Range, condition As Variant, Optional sumRange As Range) As Variant()
    Dim sumArray() As Variant, leftArgArray() As Variant

    If leftArgRange.Cells.CountLarge > 1 Then
        leftArgArray = Intersect(leftArgRange.Worksheet.UsedRange, leftArgRange).Value2
    ElseIf leftArgRange.Cells.Count = 1 Then
        leftArgArray = Array(leftArgRange.Cells(1, 1).Value2)
    Else
        Exit Function   'return empty array
    End If

    If sumRange Is Nothing Then
        sumArray = leftArgArray
    Else
        sumArray = Intersect(sumRange.Worksheet.UsedRange, sumRange).Value2
    End If

    Dim filteredArr() As Variant
    ReDim filteredArr(0 To leftArgRange.Cells.Count - 1)

    Dim v As Variant
    Dim i As Long, j As Long, filteredCount As Long

    For i = LBound(leftArgArray) To UBound(leftArgArray)
        For j = LBound(leftArgArray, 2) To UBound(leftArgArray, 2)
            If Compare(leftArgArray(i, j), condition) Then
                filteredArr(filteredCount) = sumArray(i, j)
                filteredCount = filteredCount + 1
            End If
        Next j
    Next i

    If filteredCount > 0 Then
        ReDim Preserve filteredArr(0 To filteredCount - 1)
        GetFilteredArray = filteredArr
    End If

End Function

Private Function Compare(leftArg As Variant, condition As Variant) As Boolean
    On Error Resume Next
    Dim rightArg As Variant
    If VarType(condition) = vbString Then
        'parse String
        If condition Like ">=*" Then
            rightArg = Mid(condition, 3)
            Compare = leftArg >= IIf(IsNumeric(rightArg), CDec(rightArg), rightArg)
        ElseIf condition Like "<=*" Then
            rightArg = Mid(condition, 3)
            Compare = leftArg <= IIf(IsNumeric(rightArg), CDec(rightArg), rightArg)
        ElseIf condition Like ">*" Then
            rightArg = Mid(condition, 2)
            Compare = leftArg > IIf(IsNumeric(rightArg), CDec(rightArg), rightArg)
        ElseIf condition Like "<*" Then
            rightArg = Mid(condition, 2)
            Compare = leftArg < IIf(IsNumeric(rightArg), CDec(rightArg), rightArg)
        ElseIf condition Like "**LIKE**" Then
            rightArg = Mid(condition, 7)
            Compare = InStr(1, leftArg, rightArg, vbTextCompare) > 0
        Else
            'assume equals
            rightArg = condition
            Compare = leftArg = rightArg
        End If
    Else
        'assume other primitive/struct such as Date, numeric, boolean etc
        rightArg = condition
        Compare = leftArg = rightArg
    End If

End Function

Call from worksheet:

Public Function VBA_SUMIF(leftArgRange As Range, condition As Variant, Optional sumRange As Range) As Double
    Dim filteredArr() As Variant
    filteredArr = GetFilteredArray(leftArgRange, condition, sumRange)

    On Error Resume Next
    Dim i As Long, total As Double
    For i = LBound(filteredArr) To UBound(filteredArr)
        total = total + filteredArr(i)
    Next i

    VBA_SUMIF = total
End Function

Public Function VBA_CONCATIF(leftArgRange As Range, condition As Variant, Optional sumRange As Range, Optional delimiter As String = "") As String
    Dim filteredArr() As Variant
    filteredArr = GetFilteredArray(leftArgRange, condition, sumRange)

    VBA_CONCATIF = Join(filteredArr, delimiter)
End Function

Public Function VBA_COUNTIF(leftArgRange As Range, condition As Variant) As Long
    Dim filteredArr() As Variant
    filteredArr = GetFilteredArray(leftArgRange, condition)

    On Error Resume Next
    VBA_COUNTIF = UBound(filteredArr) - LBound(filteredArr) + 1
End Function

Answer:

You can use many worksheet functions within VBA. Say our data is like:

enter image description here

We put in a standard module:

Public Function Vsumif(crrange As Range, crit As String, which As Range)
    With Application.WorksheetFunction
        Vsumif = .SumIf(crrange, crit, which)
    End With
End Function

and then in some cell, enter:

=vsumif(A:A,">=10",C:C)

and it will yield the proper result.

To use the UDF() within a sub:

Sub demo()
    Dim x As Variant

    x = Vsumif(Range("A:A"), ">=10", Range("C:C"))
    MsgBox x
End Sub

enter image description here