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
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Hello, I checked your question and I did not understand. Because in the title it says "SUMIF", but in your examples I don't see any sum.
But reviewing the macro, it does perform the sum.
I review it and if I can, I will gladly help you.
 
Upvote 0
Hello, I checked your question and I did not understand. Because in the title it says "SUMIF", but in your examples I don't see any sum.
But reviewing the macro, it does perform the sum.
I review it and if I can, I will gladly help you.
Dear Mr. Danteamor,

Thanks to your reply, Okay you can see from the sheet "recon" as follows:
1. sumif results from the data source of the sheet "OPS" with blue marking in sheet "recon"
2. sumif results from the data source of the sheet "DBALL" with yellow marking in sheet "recon"
3. sumif results from the data source of the sheet "IFGALL" with red marking in sheet "recon"
If you don't understand, let me know so I can explain it to you.

Thanks
roykana
 
Upvote 0
Hello, I checked your question and I did not understand. Because in the title it says "SUMIF", but in your examples I don't see any sum.
But reviewing the macro, it does perform the sum.
I review it and if I can, I will gladly help you.
if from the vba code I can only do sumif for one criteria only and can process from the data sheet source "OPS" in column B then the result in sheet "recon" in column B
 
Upvote 0
The 3 sheets have different structure, therefore the macro has a cycle for each sheet.
I recommend that you try a considerable sample so that you can review the results of the summations.

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
    lr = Sheets(shs(i)).Range(shs(i + 1) & Rows.Count).End(3).Row
    lt = lt + lr
    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
  
  ReDim d(1 To lt, 1 To 31)
  
  'OPS
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      n = n + 1
      dic(a(i, 1)) = n
      d(n, 1) = a(i, 1)
    End If
    j = dic(a(i, 1))
    For k = 2 To 6
      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

  Sheets("RECON").Range("A3").Resize(n, UBound(d, 2)).Value = d
End Sub
 
Upvote 0
The 3 sheets have different structure, therefore the macro has a cycle for each sheet.
I recommend that you try a considerable sample so that you can review the results of the summations.

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
    lr = Sheets(shs(i)).Range(shs(i + 1) & Rows.Count).End(3).Row
    lt = lt + lr
    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
 
  ReDim d(1 To lt, 1 To 31)
 
  'OPS
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      n = n + 1
      dic(a(i, 1)) = n
      d(n, 1) = a(i, 1)
    End If
    j = dic(a(i, 1))
    For k = 2 To 6
      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

  Sheets("RECON").Range("A3").Resize(n, UBound(d, 2)).Value = d
End Sub
Dear Mr. Danteamor,
Thanks you for your reply.
This is perfect but there is little that needs to be set:
1. For the blank result in the sheet "recon" is replaced with 0 such as the result in the sheet "recon" from column b to f i.e. sumif result from the data sheet source "OPS"
2. For sum as the result in the "recon" sheet as in column b8 to column f8 is not yet in column G up to column AE
3. for AF columns up to AO columns in sheet "recon" can be done with vba code so that it becomes a process at once?
Can you add some comments to your code so I can learn and understand?
SUMIF VBA ARRAY & DICTIONARY.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAO
1OPSPURCHASESALESRET SALESRET PURCHIFGALLCALCULATIONCHECK
2ITEM NOBOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2
301-1738009836101523636363636101523610152sssss
401-17380171610654606060603610152610654nssnssns
501-1738018512107513636363636101521210751nssnssns
601-1738018610111213146060606036112521011121314nssnsnsns
701-173801870000000000sssss
864412628216441262821nsnsnsnsns
RECON
Cell Formulas
RangeFormula
AF3:AJ7AF3=(B3+G3+Q3)-(L3+V3)
AK3:AO8AK3=IF(AA3=AF3,"s","ns")
AF8:AJ8AF8=SUM(AF3:AF7)



thanks
roykana
 
Upvote 0
1. For the blank result in the sheet "recon" is replaced with 0 such as the result in the sheet "recon" from column b to f i.e. sumif result from the data sheet source "OPS"
2. For sum as the result in the "recon" sheet as in column b8 to column f8 is not yet in column G up to column AE
3. for AF columns up to AO columns in sheet "recon" can be done with vba code so that it becomes a process at once?
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?
 
Upvote 0
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?

there is no problem with the macro

for point 1 I marked a black circle in the column showing the value 0 because there was no data from the source so the other column should have a value of 0 instead of blank and for point 2 I mean circled in blue for other columns not summing below
 

Attachments

  • 05012021.JPG
    05012021.JPG
    47.7 KB · Views: 8
Upvote 0
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?

Yes, that's right, totals at the end of the data
for point 3 what I mean is the AF column to the AO column in the "recon" sheet I want to use the vba code because for now it uses the excel formula
 
Upvote 0
previous
SUMIF VBA ARRAY & DICTIONARY.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAO
1OPSPURCHASESALESRET SALESRET PURCHIFGALLCALCULATIONCHECK
2ITEM NOBOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2
301-1738009836101523636363636101523610152sssss
401-17380171610654606060603610152610654nssnssns
501-1738018512107513636363636101521210751nssnssns
601-1738018610111213146060606036112521011121314nssnsnsns
701-173801870000000000sssss
864412628216441262821nsnsnsnsns
RECON
Cell Formulas
RangeFormula
AF3:AJ7AF3=(B3+G3+Q3)-(L3+V3)
AK3:AO8AK3=IF(AA3=AF3,"s","ns")
AF8:AJ8AF8=SUM(AF3:AF7)


results in desired
test.xlsx
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAO
1OPSPURCHASESALESRET SALESRET PURCHIFGALLCALCULATIONCHECK
2ITEM NOBOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2BOJCJRM18M07MD2
301-17380098361015236000036000036000036000036101523610152sssss
401-173801716106540060000060000060000060003610152610654nssnssns
501-17380185121075100036000036000036000036036101521210751nssnssns
601-17380186101112131400006000006000006000006036112521011121314nssnsnsns
701-1738018700000000000000000000000000000000000sssss
864412628213606036603606036603606036603606036601444152086441262821nssnsnsns
RECON
Cell Formulas
RangeFormula
AF3:AJ7AF3=(B3+G3+Q3)-(L3+V3)
AK3:AO8AK3=IF(AA3=AF3,"s","ns")
G8:AJ8G8=SUM(G3:G7)


for which I mark the color orange and bold it is what I mean for point 1 and for which I mark the color aqua and bold it is what I mean for point 2
 
Upvote 0

Forum statistics

Threads
1,215,453
Messages
6,124,918
Members
449,195
Latest member
Stevenciu

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