VBA SumIf in an Array

Question

I'm trying to write a VBA code to do a SumIf in an array, as my worksheet has about 200k rows, and multiple formulas in other sheets, using a formula or .WorksheetFunction.SumIf takes too long. Also, my worksheet is unsorted as the last rows are always the most recent data added.

My Sheet has 15 columns, but i'm only using A B C D for the sumif. A,C,D = contain text and column B contains the numbers I want to sum.

I've tried the following code which works just fine, but takes about 5 min to complete the calulations.

Dim i As Long

With Sheets("Sheet1")

x = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To x
    .Cells(i, 7).Value2 = Application.WorksheetFunction.SumIfs(.Range("B:B"), _
                    .Range("C:C"), .Range(("C") & i), _
                    .Range("A:A"), .Range(("A") & i), _
                    .Range("D:D"), .Range(("D") & i))
        Next i
End With

End Sub

I've started working on an array VBA to replace the sumif as it would be much faster but I can't manage to get it working properly. The code I'm using is below.

Dim i As Long
Dim arrRAM As Variant
Dim arrType As Variant
Dim arrR As Variant
Dim arrO As Variant
Dim arrX As Variant
Dim arrY As Variant
Dim arrD As Variant
Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")

With Sheets("Sheet2")
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arrRAM = .Cells(2, 2).Resize(x - 1).Value2
    arrType = .Cells(2, 3).Resize(x - 1).Value2
    arrR = .Cells(2, 1).Resize(x - 1).Value2
    arrO = .Cells(2, 4).Resize(x - 1).Value2
    arrX = .Cells(2, 5).Resize(x - 1, 2).Value2
    arrY = .Cells(2, 6).Resize(x - 1).Value2
    arrD = .Cells(2, 7).Resize(x - 1).Value2

For i = LBound(arrRAM, 1) To UBound(arrRAM, 1)
    arrY(i, 1) = arrType(i, 1) & arrR(i, 1) & arrO(i, 1)
    arrX(i, 1) = arrType(i, 1) & arrR(i, 1) & arrO(i, 1)
    arrX(i, 2) = arrRAM(i, 1)
Next i

For x = LBound(arrX, 1) To UBound(arrX, 1)
    dic(arrX(x, 1)) = arrX(x, 2)
Next x

tot = 0
For i = LBound(arrX, 1) To UBound(arrX, 1)
      If dic.Exists(arrY(i, 1)) Then
        tot = tot + arrX(i, 2)
    End If
    arrD(i, 1) = tot
    Next i

Debug.Print arrY(1, 1)
    .Cells(2, 6).Resize(UBound(arrD, 1)).Value2 = arrD

End With
End Sub

The idea behind it was to concatenate A,C & D into a single array. Then get another array which has the concatenated values + column B. Then it should search for the concatenated values from the first array in the second one(it looks like it does this part just fine), then it should do the sum.

The issue comes when I have to add up the values, it just takes the first value in column B then adds the next value into the first one. Below you can the results on sample data for the normal SumIf Formula/First Vba code and the second vba code.

Is there a way to fix my vba code to output the same results as the first one/sumif formula? Any help is appreciated.

Scott Craner Scott Craner · Accepted Answer · 2020-03-02T19:58:44

this works with variant arrays:

     With Worksheets("Sheet1")
        Dim x As Long
        x = .Cells(.Rows.Count, 1).End(xlUp).Row

        Dim rngArr() As Variant
        rngArr = .Range(.Cells(2, 1), .Cells(x, 4)).Value

        Dim outArr As Variant
        ReDim outArr(1 To x, 1 To 1)

        Dim i As Long
        For i = LBound(rngArr, 1) To UBound(rngArr, 1)
            Dim j As Long
            For j = LBound(rngArr, 1) To UBound(rngArr, 1)
                If rngArr(i, 1) = rngArr(j, 1) And rngArr(i, 3) = rngArr(j, 3) And rngArr(i, 4) = rngArr(j, 4) Then
                    outArr(i, 1) = outArr(i, 1) + rngArr(j, 2)
                End If
            Next j
        Next i

        .Cells(2, 7).Resize(UBound(outArr, 1), 1).Value2 = outArr
    End With

VBA SumIf in an Array

3 Answers