SUMIFS faster in vba array and scripting.dictionary - arrays

Question

I want to use the vba sumifs array and scripting.dictionary because there are a hundred thousand records there may be the best solution. For information sheet "DBALL" is the source and sheet "RECON" is the result. I also found the vba code below but it doesn't match the result.
info formula sheet "RECON" column B "In" = SUMIFS(DBALL!$A$2:$A$5,DBALL!$C$2:$C$5,RECON!$A2,DBALL!$B$2:$B$5,RECON!B$1)
info formula sheet "RECON" column c "Out" = SUMIFS(DBALL!$A$2:$A$5,DBALL!$C$2:$C$5,RECON!$A2,DBALL!$B$2:$B$5,RECON!C$1)
info formula sheet "RECON" column d "difference" = B2-C2
Thanks
Sub SUMIFSFASTER()
Dim arr, ws, rng As Range, keyCols, valueCol As Long, destCol As Long, i As Long, frm As String, sep As String
Dim t, dict, arrOut(), arrValues(), v, tmp, n As Long
keyCols = Array(2, 3) 'these columns form the composite key
valueCol = 1 'column with values (for sum)
destCol = 4 'destination for calculated values
t = Timer
Set ws = Sheets("DBALL")
Set rng = ws.Range("A1").CurrentRegion
n = rng.Rows.Count - 1
Set rng = rng.Offset(1, 0).Resize(n) 'exclude headers
'build the formula to create the row "key"
For i = 0 To UBound(keyCols)
frm = frm & sep & rng.Columns(keyCols(i)).Address
sep = "&""|""&"
Next i
arr = ws.Evaluate(frm) 'get an array of composite keys by evaluating the formula
arrValues = rng.Columns(valueCol).Value 'values to be summed
ReDim arrOut(1 To n, 1 To 1) 'this is for the results
Set dict = CreateObject("scripting.dictionary")
'first loop over the array counts the keys
For i = 1 To n
v = arr(i, 1)
If Not dict.exists(v) Then dict(v) = Array(0, 0) 'count, sum
tmp = dict(v) 'can't modify an array stored in a dictionary - pull it out first
tmp(0) = tmp(0) + 1 'increment count
tmp(1) = tmp(1) + arrValues(i, 1) 'increment sum
dict(v) = tmp 'return the modified array
Next i
'second loop populates the output array from the dictionary
For i = 1 To n
arrOut(i, 1) = dict(arr(i, 1))(1) 'sumifs
'arrOut(i, 1) = dict(arr(i, 1))(0) 'countifs
'arrOut(i, 1) = dict(arr(i, 1))(1) / dict(arr(i, 1))(0) 'averageifs
Next i
'populate the results
rng.Columns(destCol).Value = arrOut
Debug.Print "Checked " & n & " rows in " & Timer - t & " secs"
End Sub
Source
RESULT

Answer 1

As said in the comments a better solution is probably to use a pivot table resp. power pivot.
If you are after a solution with VBA and want to use a dictionary I would probably use the following code.
First you need to create a class cVal which stores the values you are after
Option Explicit
Public qtyIn As Double
Public qtyOut As Double
Then you can use the following code
Option Explicit
Sub useDict()
Const COL_VAL = 1
Const COL_INOUT = 2
Const COL_COMBINE = 3
Const GRO_IN = "IN"
Const GRO_OUT = "OUT"
Dim rg As Range, ws As Worksheet
' Get the range with the data
Set ws = Worksheets("DBALL")
Set rg = ws.Range("A1").CurrentRegion
Set rg = rg.Offset(1, 0).Resize(rg.Rows.Count - 1)
Dim vDat As Variant
vDat = rg
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim Key As Variant, gro As Variant
Dim i As Long, sngVal As cVal
For i = LBound(vDat, 1) To UBound(vDat, 1)
' Key of the dictionary
Key = vDat(i, COL_COMBINE)
' trim the value and do not consider upper/lower case
gro = UCase(Trim(vDat(i, COL_INOUT)))
If dict.Exists(Key) Then
' just increase the "member" values of the already stored object
Set sngVal = dict(Key)
With sngVal
If gro = GRO_IN Then
.qtyIn = .qtyIn + vDat(i, COL_VAL)
End If
If gro = GRO_OUT Then
.qtyOut = .qtyOut + vDat(i, COL_VAL)
End If
End With
Else
' Create a new object which stores the summed values for "IN" resp "OUT"
Set sngVal = New cVal
With sngVal
If gro = GRO_IN Then
.qtyIn = vDat(i, COL_VAL)
End If
If gro = GRO_OUT Then
.qtyOut = vDat(i, COL_VAL)
End If
End With
dict.Add Key, sngVal
End If
Next i
' write Dictionary
' put the values of the dictionary in an array
' this is faster than writing each single line directly to the sheet
ReDim vDat(1 To dict.Count, 1 To 4)
i = 1
For Each Key In dict.Keys
vDat(i, 1) = Key
vDat(i, 2) = dict(Key).qtyIn
vDat(i, 3) = dict(Key).qtyOut
vDat(i, 4) = Abs(dict(Key).qtyIn - dict(Key).qtyOut)
i = i + 1
Next Key
'write Header
Set rg = Worksheets("RECON").Range("A1")
Set rg = rg.Resize(, 4)
rg.Clear
rg = Array("COMBINE", "In", "Out", "Diff")
Set rg = Worksheets("RECON").Range("A2")
Set rg = rg.Resize(dict.Count, 4)
rg.Clear
rg = vDat
' PS Code to add a sum row below the data
Set rg = Worksheets("RECON").Range("A" & dict.Count + 2)
Set rg = rg.Resize(1, 4)
rg.Clear
'rg.Columns(1).Value = "Total"
Dim bSum As Double, rDat As Variant
rDat = Application.Index(vDat, , 2)
bSum = WorksheetFunction.sum(rDat)
rg.Columns(2).Value = bSum
rDat = Application.Index(vDat, , 3)
bSum = WorksheetFunction.sum(rDat)
rg.Columns(3).Value = bSum
rDat = Application.Index(vDat, , 4)
bSum = WorksheetFunction.sum(rDat)
rg.Columns(4).Value = bSum
End Sub
But I doubt that to be faster than a Pivot Table