asked on

VBA alternative for SumIf() and CountIf() evaluating an internal array

I am trying to get the function of Application.SumIf() and Application.CountIf() for an internal VBA array defined as Variant.

It is fairly easy to achieve if the criteria Crit in the (non-working) Application.CountIf(tmpArr, Crit) is just supposed to be Equal to the values in the array, but I need Crit to be able to contain criterias like >10, <5 and ideally even wildcards.

Below is a code snippet showing what I have tried for CountIf() , the error it produces and also how I hoped it would work.

Sub CountIfTest()
Dim tmpArr As Variant, Crit As String, tmp As Variant, i As Long
    Crit = InputBox("Criteria", , "<6")
    tmpArr = Array(5, 3, 12, 4, 0, 4, 3, 2, 1)
        
'    MsgBox Application.CountIf(tmpArr, Crit) 'Gives error "Object required" since tmpArr is not a Worksheet.Range()
    For Each tmp In tmpArr
        If tmp Like Crit Then i = i + 1         '"Like" doesn't work, but "If tmp = Crit" works
    Next tmp
    MsgBox "Like test " & i
    MsgBox "Filter test " & UBound(Filter(tmpArr, Crit, True, 0)) + 1                   'Works for Equal, but not for < or > or wildcards
    MsgBox "Match test " & Application.Count(Application.Match(tmpArr, Array(Crit), 0)) 'Works for Equal, but not for < or > or wildcards
End Sub

Open in new window

Any creative ideas?

Thanks,
Jörgen

Roy Cox

maybe this

Option Explicit

Function VBASumIf()
    Dim arr, arrSplit
    Dim iX As Integer, lSum As Integer, lVar As Long
    Dim strTemp
    arr = "1,5,2,7"
    lVar = 3
    arrSplit = Split(arr, ",")
    For iX = 0 To UBound(arrSplit)
      If CLng(arrSplit(iX)) > lVar Then lSum = lSum + arrSplit(iX)
    Next
    MsgBox lSum
End Function

Open in new window

Roy Cox

Alternative

Option Explicit

Function VBASumIf(arr, lVar)
    Dim arrSplit
    Dim iX As Integer, lSum As Integer
    Dim strTemp
    arrSplit = Split(arr, ",")
    For iX = 0 To UBound(arrSplit)
      If CLng(arrSplit(iX)) > lVar Then lSum = lSum + arrSplit(iX)
    Next
    VBASumIf = lSum
End Function

Sub RunFuncArray()
MsgBox VBASumIf("1,5,2,7", 3)
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

SOLUTION

Roy Cox

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Simulog

ASKER

Thank you Rgonzo and Roy!

I used mainly Rgonzo's solution since it allowed for <, >, <=, >=, and <> as well as =

I added an "If" to handle strings as well, and also so the SumIf can have an other array that it sums. But no error handling here, which there should be, but it depends on how the user intends to use it...

Sub CountIfTest1()
Dim tmpArr As Variant, Crit As String
    Crit = InputBox("Criteria", , "<6")
    tmpArr = Array(5, 3, 12, 4, 0, 4, 3, 2, 1)
    MsgBox CountIfFcn(tmpArr, Crit)
End Sub
Sub CountIfTest2()
Dim tmpArr As Variant, Crit As String
    Crit = InputBox("Criteria", , "<" & chr(34) & "Don" & chr(34))  'Messy just to get the quotation marks around "Don"
    tmpArr = Array("Bill", "Jane", "Don", "Bill", "Jim", "Jane")
    MsgBox CountIfFcn(tmpArr, Crit)
End Sub
Function CountIfFcn(tmpArr As Variant, Crit As String) As Long
'Main solution by Rgonzo1971, modified for strings by Jörgen Möller. It only allows one-dim array.
Dim Itm As Variant, res As Long
    For Each Itm In tmpArr
        If IsNumeric(Itm) Then
            res = res + Evaluate("=--(" & Itm & Crit & ")")
        Else
            res = res - Evaluate("=(" & chr(34) & Itm & chr(34) & Crit & ")")
        End If
    Next Itm
    CountIfFcn = res
End Function
Sub SumIfTest1()
Dim tmpArr As Variant, tmpArr2 As Variant, Crit As String
    Crit = InputBox("Criteria", , "<" & chr(34) & "Don" & chr(34))  'Messy just to get the quotation marks around "Don"
    tmpArr = Array("Bill", "Jane", "Don", "Bill", "Jim", "Jane")
    tmpArr2 = Array(5, 3, 12, 4, 7, 3)
    MsgBox SumIfFcn(tmpArr, Crit, tmpArr2)
End Sub
Function SumIfFcn(tmpArr As Variant, Crit As String, Optional tmpArr2 As Variant) As Long
'Main solution by Rgonzo1971, modified for strings by Jörgen Möller. It only allows one-dim arrays.
Dim Item As Variant, res As Long, idxItm As Long
    For idxItm = LBound(tmpArr) To UBound(tmpArr)
        If IsNumeric(tmpArr(idxItm)) Then
            If Evaluate("=--(" & tmpArr(idxItm) & Crit & ")") Then res = res + tmpArr2(idxItm)
        Else
            If Evaluate("=(" & chr(34) & tmpArr(idxItm) & chr(34) & Crit & ")") Then res = res + tmpArr2(idxItm)
        End If
    Next idxItm
    SumIfFcn = res
End Function

Open in new window

Roy Cox

Pleased to help