SUMIF VBA ARRAY & DICTIONARY

roykana

Active Member
Joined
Mar 8, 2018
Messages
311
Office Version
  1. 2010
Platform
  1. Windows
Dear all master,
I want a fast code sumif vba array and dictionary because there are three hundred thousand records. I've also made the sumif vba array and dictionary code but it only works for 1 column and 1 criteria results.
Please help for the solution.
sheet name "OPS" with table name "OPS" with blue marking in the desired result in sheet "RECON"

SUMIF VBA ARRAY & DICTIONARY.xlsm
ABCDEF
1ITEM NOBOJCJRM18M07MD2
201-173800983610152
301-17380171610654
401-173801851210751
501-173801861011121314
66441262821
OPS
Cell Formulas
RangeFormula
B6B6=SUBTOTAL(109,[BOJ])
C6C6=SUBTOTAL(109,[CJR])
D6D6=SUBTOTAL(109,[M18])
E6E6=SUBTOTAL(109,[M07])
F6F6=SUBTOTAL(109,[MD2])


sheet name "DBALL" with table name "DBALL" with yellow marking in the desired result in sheet "RECON"

SUMIF VBA ARRAY & DICTIONARY.xlsm
ABCDEFGHIJKLMNOPQRSTU
1PNMITMITCQTYUNICIUNODDPRNCURQABGLBDPTDTSCIAUNBDATESACDEPTTRANSGROUPITEM NO
2GPPI11801001TEST S 20525 DIGITALITYT2052536Pcs8900001002/01/2018A.01.01.001.063BOJPURCHASEIn01-17380098
3GPPI11801002TEST S 20551 DELIOT2055160Pcs8900001002/01/2018A.01.01.001.063M18PURCHASEIn01-17380171
4GPPI11801003TEST S 20526 DIGITALITYT2052636Pcs8900001002/01/2018A.01.01.001.063M07PURCHASEIn01-17380185
5GPPI11801004TEST S 20552 DELIOT2055260Pcs8900001002/01/2018A.01.01.001.063MD2PURCHASEIn01-17380186
6GPPI11801005TEST S 20525 DIGITALITYT2052536Pcs8900001002/01/2018A.01.01.001.063BOJSALES01-17380098
7GPPI11801006TEST S 20551 DELIOT2055160Pcs8900001002/01/2018A.01.01.001.063M18SALES01-17380171
8GPPI11801007TEST S 20526 DIGITALITYT2052636Pcs8900001002/01/2018A.01.01.001.063M07SALES01-17380185
9GPPI11801008TEST S 20552 DELIOT2055260Pcs8900001002/01/2018A.01.01.001.063MD2SALES01-17380186
10GPPI11801009TEST S 20525 DIGITALITYT2052536Pcs8900001002/01/2018A.01.01.001.063BOJRET PURCH01-17380098
11GPPI11801010TEST S 20551 DELIOT2055160Pcs8900001002/01/2018A.01.01.001.063M18RET PURCH01-17380171
12GPPI11801011TEST S 20526 DIGITALITYT2052636Pcs8900001002/01/2018A.01.01.001.063M07RET PURCH01-17380185
13GPPI11801012TEST S 20552 DELIOT2055260Pcs8900001002/01/2018A.01.01.001.063MD2RET PURCH01-17380186
14GPPI11801013TEST S 20525 DIGITALITYT2052536Pcs8900001002/01/2018A.01.01.001.063BOJRET SALES01-17380098
15GPPI11801014TEST S 20551 DELIOT2055160Pcs8900001002/01/2018A.01.01.001.063M18RET SALES01-17380171
16GPPI11801015TEST S 20526 DIGITALITYT2052636Pcs8900001002/01/2018A.01.01.001.063M07RET SALES01-17380185
17GPPI11801016TEST S 20552 DELIOT2055260Pcs8900001002/01/2018A.01.01.001.063MD2RET SALES01-17380186
DBALL


sheet name "IFGALL" with table name "IFGALL" with red marking in the desired result in sheet "RECON"

SUMIF VBA ARRAY & DICTIONARY.xlsm
ABCDE
1ITMITCQOHGROUP DEPTITEM NO
2TEST S 20525 DIGITALITYT2052536BOJ01-17380098
3TEST S 20551 DELIOT2055136BOJ01-17380171
4TEST S 20526 DIGITALITYT2052636BOJ01-17380185
5TEST S 20552 DELIOT2055236BOJ01-17380186
6TEST S 20525 DIGITALITYT2052510CJR01-17380098
7TEST S 20551 DELIOT2055110CJR01-17380171
8TEST S 20526 DIGITALITYT2052610CJR01-17380185
9TEST S 20552 DELIOT2055211CJR01-17380186
10TEST S 20525 DIGITALITYT205251M1801-17380098
11TEST S 20551 DELIOT205511M1801-17380171
12TEST S 20526 DIGITALITYT205261M1801-17380185
13TEST S 20552 DELIOT205522M1801-17380186
14TEST S 20525 DIGITALITYT205255M0701-17380098
15TEST S 20551 DELIOT205515M0701-17380171
16TEST S 20526 DIGITALITYT205265M0701-17380185
17TEST S 20552 DELIOT205525M0701-17380186
18TEST S 20525 DIGITALITYT205252MD201-17380098
19TEST S 20551 DELIOT205512MD201-17380171
20TEST S 20526 DIGITALITYT205262MD201-17380185
21TEST S 20552 DELIOT205522MD201-17380186
IFGALL



desired result
SUMIF VBA ARRAY & DICTIONARY.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAO
1OPSPURCHASESALESRET SALESRET PURCHIFGALLCALCULATIONCHECK
2ITEM NOBOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2
301-17380098361015236000036000036000036000036101523610152sssss
401-1738017161065400600000600000600000600036101523610152sssss
501-17380185121075100036000036000036000036036101523610152sssss
601-17380186101112131400006000006000006000006036112523610152snsnsss
7TOTAL6441262821360603660360603660360603660360603660144415208144404208snsnsss
RECON
Cell Formulas
RangeFormula
B3:B6B3=SUMIF(OPS[ITEM NO],$A3,OPS[BOJ])
C3:C6C3=SUMIF(OPS[ITEM NO],$A3,OPS[CJR])
D3:D6D3=SUMIF(OPS[ITEM NO],$A3,OPS[M18])
E3:E6E3=SUMIF(OPS[ITEM NO],$A3,OPS[M07])
F3:F6F3=SUMIF(OPS[ITEM NO],$A3,OPS[MD2])
G3:K6G3=SUMIFS(DBALL[QTY],DBALL[ITEM NO],RECON!$A3,DBALL[DEPT],RECON!G$2,DBALL[TRANS],RECON!$G$1)
L3:P6L3=SUMIFS(DBALL[QTY],DBALL[ITEM NO],RECON!$A3,DBALL[DEPT],RECON!L$2,DBALL[TRANS],RECON!$L$1)
Q3:U6Q3=SUMIFS(DBALL[QTY],DBALL[ITEM NO],RECON!$A3,DBALL[DEPT],RECON!Q$2,DBALL[TRANS],RECON!$Q$1)
V3:Z6V3=SUMIFS(DBALL[QTY],DBALL[ITEM NO],RECON!$A3,DBALL[DEPT],RECON!V$2,DBALL[TRANS],RECON!$V$1)
AA3:AE6AA3=SUMIFS(IFGALL[QOH],IFGALL[ITEM NO],RECON!$A3,IFGALL[GROUP DEPT],RECON!AA$2)
AF3:AJ6AF3=(B$3+G$3+Q$3)-(L$3+V$3)
AK3:AO7AK3=IF(AA3=AF3,"s","ns")
B7:AJ7B7=SUM(B3:B6)


VBA Code:
Sub sumifarraydictionary()

   Dim Ary As Variant, Tmp As Variant
   Dim r As Long
   t = Timer
  
   Ary = Sheets("OPS").ListObjects("OPS").DataBodyRange.Value2
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, 1)) Then
            .Add Ary(r, 1), Array(Ary(r, 2), 0, 0)
         Else
            Tmp = .Item(Ary(r, 1))(0) + Ary(r, 2)
            .Item(Ary(r, 1)) = Array(Tmp, 0, 0)
         End If
      Next r
Sheets("RECON").Range("A3").Resize(.Count).Value = Application.Transpose(.Keys)
      Sheets("RECON").Range("B3").Resize(.Count, 1).Value = Application.Index(.items, 0)
   End With
      Debug.Print "It's done in: " & Timer - t & " seconds"
End Sub
 
I don't understand the points.
Some problem with the macro?
Or is it just format and totals at the end of the data, in your example, do you want the macro to put the totals in row 8?
@DanteAmor
Dear Mr. DanteAmor
if from my previous explanation there is something that is not understood please tell me so that I can explain again
thanks
roykana
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
@DanteAmor
Dear Mr. Dante Amor,
Sorry I'm late to reply. Your code is perfect and you are really my teacher.
Can you add some comments to your code so I can learn and understand?
Thanks
roykana
 
Upvote 0
Yes, that's right, totals at the end of the data

Can you add some comments to your code

Updated code with totals and comments.

VBA Code:
Sub SumIfs()
  Dim dic As Object
  Dim shs As Variant
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lt As Long, m As Long, n As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  shs = Array("OPS", "A", "DBALL", "U", "IFGALL", "E")
  
  For i = 0 To UBound(shs) Step 2
    'Find the last row with data from each sheet.
    lr = Sheets(shs(i)).Range(shs(i + 1) & Rows.Count).End(3).Row
    'Calculate the possible total of rows, that is, the sum of the rows of all the sheets
    lt = lt + lr
    'Fill a matrix for each sheet
    If i = 0 Then a = Sheets(shs(i)).Range("A2:F" & lr).Value
    If i = 2 Then b = Sheets(shs(i)).Range("A2:U" & lr).Value
    If i = 4 Then c = Sheets(shs(i)).Range("A2:E" & lr).Value
  Next
  
  'To fill everything with 0
  ReDim d(1 To lt + 1, 1 To 31)
  For i = 1 To UBound(d, 1)
    For j = 2 To UBound(d, 2)
      d(i, j) = 0
    Next
  Next
  
  'OPS
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      'If it is not in the dictionary, the row of the output matrix is ??increased by one
      n = n + 1
      'The dictionary is filled with the row number
      dic(a(i, 1)) = n
      'The array is filled, the value is put in the row number, column 1
      d(n, 1) = a(i, 1)
    End If
    'Gets the row number in j
    j = dic(a(i, 1))
    For k = 2 To 6
      'The values are added within the matrix, in row j, from column 2 to column 5
      d(j, k) = d(j, k) + a(i, k)
    Next
  Next
  
  'DBALL
  For i = 1 To UBound(b, 1)
    If Not dic.exists(b(i, 21)) Then
      n = n + 1
      dic(b(i, 21)) = n
      d(n, 1) = b(i, 21)
    End If
    j = dic(b(i, 21))
    Select Case b(i, 19)
      Case "PURCHASE":  m = 7
      Case "SALES":     m = 12
      Case "RET SALES": m = 17
      Case "RET PURCH": m = 22
      Case Else:        m = 0
    End Select
    Select Case b(i, 18)
      Case "BOJ": k = m + 0
      Case "CJR": k = m + 1
      Case "M18": k = m + 2
      Case "M07": k = m + 3
      Case "MD2": k = m + 4
      Case Else:  k = 0
    End Select
    If m > 0 And k > 0 Then d(j, k) = d(j, k) + b(i, 4)
  Next
  
  'IFGALL
  For i = 1 To UBound(c, 1)
    If Not dic.exists(c(i, 5)) Then
      n = n + 1
      dic(c(i, 5)) = n
      d(n, 1) = c(i, 5)
    End If
    j = dic(c(i, 5))
    Select Case c(i, 4)
      Case "BOJ": k = 27
      Case "CJR": k = 28
      Case "M18": k = 29
      Case "M07": k = 30
      Case "MD2": k = 31
      Case Else:  k = 0
    End Select
    If k > 0 Then d(j, k) = d(j, k) + c(i, 3)
  Next
  
  'Calculate totals
  k = n + 1
  For i = 1 To n
    For j = 2 To UBound(d, 2)
      d(k, j) = d(k, j) + d(i, j)
    Next
  Next

  Sheets("RECON").Range("A3").Resize(n + 1, UBound(d, 2)).Value = d
End Sub
 
Upvote 0
Solution
Updated code with totals and comments.

VBA Code:
Sub SumIfs()
  Dim dic As Object
  Dim shs As Variant
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lt As Long, m As Long, n As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  shs = Array("OPS", "A", "DBALL", "U", "IFGALL", "E")
 
  For i = 0 To UBound(shs) Step 2
    'Find the last row with data from each sheet.
    lr = Sheets(shs(i)).Range(shs(i + 1) & Rows.Count).End(3).Row
    'Calculate the possible total of rows, that is, the sum of the rows of all the sheets
    lt = lt + lr
    'Fill a matrix for each sheet
    If i = 0 Then a = Sheets(shs(i)).Range("A2:F" & lr).Value
    If i = 2 Then b = Sheets(shs(i)).Range("A2:U" & lr).Value
    If i = 4 Then c = Sheets(shs(i)).Range("A2:E" & lr).Value
  Next
 
  'To fill everything with 0
  ReDim d(1 To lt + 1, 1 To 31)
  For i = 1 To UBound(d, 1)
    For j = 2 To UBound(d, 2)
      d(i, j) = 0
    Next
  Next
 
  'OPS
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      'If it is not in the dictionary, the row of the output matrix is ??increased by one
      n = n + 1
      'The dictionary is filled with the row number
      dic(a(i, 1)) = n
      'The array is filled, the value is put in the row number, column 1
      d(n, 1) = a(i, 1)
    End If
    'Gets the row number in j
    j = dic(a(i, 1))
    For k = 2 To 6
      'The values are added within the matrix, in row j, from column 2 to column 5
      d(j, k) = d(j, k) + a(i, k)
    Next
  Next
 
  'DBALL
  For i = 1 To UBound(b, 1)
    If Not dic.exists(b(i, 21)) Then
      n = n + 1
      dic(b(i, 21)) = n
      d(n, 1) = b(i, 21)
    End If
    j = dic(b(i, 21))
    Select Case b(i, 19)
      Case "PURCHASE":  m = 7
      Case "SALES":     m = 12
      Case "RET SALES": m = 17
      Case "RET PURCH": m = 22
      Case Else:        m = 0
    End Select
    Select Case b(i, 18)
      Case "BOJ": k = m + 0
      Case "CJR": k = m + 1
      Case "M18": k = m + 2
      Case "M07": k = m + 3
      Case "MD2": k = m + 4
      Case Else:  k = 0
    End Select
    If m > 0 And k > 0 Then d(j, k) = d(j, k) + b(i, 4)
  Next
 
  'IFGALL
  For i = 1 To UBound(c, 1)
    If Not dic.exists(c(i, 5)) Then
      n = n + 1
      dic(c(i, 5)) = n
      d(n, 1) = c(i, 5)
    End If
    j = dic(c(i, 5))
    Select Case c(i, 4)
      Case "BOJ": k = 27
      Case "CJR": k = 28
      Case "M18": k = 29
      Case "M07": k = 30
      Case "MD2": k = 31
      Case Else:  k = 0
    End Select
    If k > 0 Then d(j, k) = d(j, k) + c(i, 3)
  Next
 
  'Calculate totals
  k = n + 1
  For i = 1 To n
    For j = 2 To UBound(d, 2)
      d(k, j) = d(k, j) + d(i, j)
    Next
  Next

  Sheets("RECON").Range("A3").Resize(n + 1, UBound(d, 2)).Value = d
End Sub
@DanteAmor
Dear Mr. Dante Amor,
It's perfectly and you're the best teacher to me.
Thanks
roykana
 
Upvote 0
@DanteAmor
Dear Mr. DanteAmor,

I have a slight problem that the results should appear in the "recon" sheet in column A, but instead in column G.

Because you are the one who made the code, you will know. Sorry to disturb your time. You are my teacher.
if possible the arrangement of the code that you made does not need to be changed but just fixes it a little.
One more thing I want to ask, do you think it is better if I clear the data first in the "recon" sheet?
thanks
roykana
VBA Code:
Sub SumIfs()
  Dim dic As Object
  Dim shs As Variant
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lt As Long, m As Long, n As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  shs = Array("TEST", "A")
 
  For i = 0 To UBound(shs) Step 2
    'Find the last row with data from each sheet.
    lr = Sheets(shs(i)).Range(shs(i + 1) & Rows.Count).End(3).Row
    'Calculate the possible total of rows, that is, the sum of the rows of all the sheets
    lt = lt + lr
    'Fill a matrix for each sheet
    If i = 0 Then a = Sheets(shs(i)).Range("A2:G" & lr).Value

  Next
 
  'To fill everything with 0
  ReDim d(1 To lt + 1, 1 To 7)
  For i = 1 To UBound(d, 1)
    For j = 2 To UBound(d, 2)
      d(i, j) = 0
    Next
  Next
 
  'OPS
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      'If it is not in the dictionary, the row of the output matrix is ??increased by one
      n = n + 1
      'The dictionary is filled with the row number
      dic(a(i, 1)) = n
      'The array is filled, the value is put in the row number, column 1
      d(n, 1) = a(i, 1)
    End If
    'Gets the row number in j
    j = dic(a(i, 1))
    For k = 7 To 7
      'The values are added within the matrix, in row j, from column 2 to column 5
      d(j, k) = d(j, k) + a(i, k)
    Next
  Next
 
 
  'Calculate totals
  k = n + 1
  For i = 1 To n
    For j = 2 To UBound(d, 2)
      d(k, j) = d(k, j) + d(i, j)
    Next
  Next

  Sheets("RECON").Range("A2").Resize(n + 1, UBound(d, 2)).Value = d
End Sub
Book3
ABCDEFG
1ITEM NOITEM 1ITC 1ITEM 2ITC 2QM18QCJR
21000TEST R 10000-1000TEST RR 10000-1000-055
31001TEST R 10010-1001TEST RR 10010-1001-01010
TEST



Book3
ABCDEFG
1ITEM NOQCJR
21000000005
310010000010
40000015
RECON
 
Upvote 0
@DanteAmor
Dear Mr. DanteAmor,

I have a slight problem that the results should appear in the "recon" sheet in column A, but instead in column G.

Because you are the one who made the code, you will know. Sorry to disturb your time. You are my teacher.
if possible the arrangement of the code that you made does not need to be changed but just fixes it a little.
One more thing I want to ask, do you think it is better if I clear the data first in the "recon" sheet?
thanks
roykana
VBA Code:
Sub SumIfs()
  Dim dic As Object
  Dim shs As Variant
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lt As Long, m As Long, n As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  shs = Array("TEST", "A")
 
  For i = 0 To UBound(shs) Step 2
    'Find the last row with data from each sheet.
    lr = Sheets(shs(i)).Range(shs(i + 1) & Rows.Count).End(3).Row
    'Calculate the possible total of rows, that is, the sum of the rows of all the sheets
    lt = lt + lr
    'Fill a matrix for each sheet
    If i = 0 Then a = Sheets(shs(i)).Range("A2:G" & lr).Value

  Next
 
  'To fill everything with 0
  ReDim d(1 To lt + 1, 1 To 7)
  For i = 1 To UBound(d, 1)
    For j = 2 To UBound(d, 2)
      d(i, j) = 0
    Next
  Next
 
  'OPS
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      'If it is not in the dictionary, the row of the output matrix is ??increased by one
      n = n + 1
      'The dictionary is filled with the row number
      dic(a(i, 1)) = n
      'The array is filled, the value is put in the row number, column 1
      d(n, 1) = a(i, 1)
    End If
    'Gets the row number in j
    j = dic(a(i, 1))
    For k = 7 To 7
      'The values are added within the matrix, in row j, from column 2 to column 5
      d(j, k) = d(j, k) + a(i, k)
    Next
  Next
 
 
  'Calculate totals
  k = n + 1
  For i = 1 To n
    For j = 2 To UBound(d, 2)
      d(k, j) = d(k, j) + d(i, j)
    Next
  Next

  Sheets("RECON").Range("A2").Resize(n + 1, UBound(d, 2)).Value = d
End Sub
Book3
ABCDEFG
1ITEM NOITEM 1ITC 1ITEM 2ITC 2QM18QCJR
21000TEST R 10000-1000TEST RR 10000-1000-055
31001TEST R 10010-1001TEST RR 10010-1001-01010
TEST



Book3
ABCDEFG
1ITEM NOQCJR
21000000005
310010000010
40000015
RECON
@DanteAmor
Dear Mr. DanteAmor,
How's the solution? And please respond.


Thanks
roykana
 
Upvote 0
I have a slight problem that the results should appear in the "recon" sheet in column A, but instead in column G.
Change this:

Sheets("RECON").Range("G2").Resize(n + 1, UBound(d, 2)).Value = d
 
Upvote 0
Change this:

Sheets("RECON"). Range("G2"). Resize(n + 1, UBound(d, 2)). Value = d
@DanteAmor
Dear Mr. Dante Amor,
Thanks for your reply, but the result I mean appears in the yellow marking in the sheet "recon", below the code is correct starting from A2 in sheet "recon"
thanks
roykana

VBA Code:
Sheets("RECON"). Range("A2"). Resize(n, UBound(d, 2)). Value = d
The desired or correct result is as below.
problem sumif.xlsm
AB
1ITEM NOQCJR
210005
3100110
415
RECON
 
Upvote 0
@DanteAmor
Dear Mr. Dante Amor,
Thanks for your reply, but the result I mean appears in the yellow marking in the sheet "recon", below the code is correct starting from A2 in sheet "recon"
thanks
roykana

VBA Code:
Sheets("RECON"). Range("A2"). Resize(n, UBound(d, 2)). Value = d
The desired or correct result is as below.
problem sumif.xlsm
AB
1ITEM NOQCJR
210005
3100110
415
RECON
@DanteAmor
Dear Mr. DanteAmor,
please respond.


Thanks
roykana
 
Upvote 0

Forum statistics

Threads
1,214,973
Messages
6,122,534
Members
449,088
Latest member
RandomExceller01

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top