PROBLEM SUMIF ARRAY IN RESULT

[roykana]

Dear All Master,
It should be in column B in the "recon" sheet which I mark yellow but I use the vba code below but the result is in column G in the sheet "recon" which I mark red. There may be something wrong in the code I edited below and I just added a little or modified it a little without changing the code structure below.

thanks
roykana

Option Explicit

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 7 to column 7
      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

Source

problem sumif.xlsm
	A	B	C	D	E	F	G
1	ITEM NO	ITEM 1	ITC 1	ITEM 2	ITC 2	QM18	QCJR
2	1000	TEST R 1000	0-1000	TEST RR 1000	0-1000-0	5	5
3	1001	TEST R 1001	0-1001	TEST RR 1001	0-1001-0	10	10
TEST

DESIRED RESULT

problem sumif.xlsm
	A	B	C	D	E	F	G
1	ITEM NO	QCJR
2	1000	0	0	0	0	0	5
3	1001	0	0	0	0	0	10
4		0	0	0	0	0	15
RECON

 

[StephenCrump]

I think you're trying to do a simple SUMIF, like this perhaps? If I'm correct, your code can be made much simpler.

Input

	A	B	C	D	E	F	G
1	ITEM NO	ITEM 1	ITC 1	ITEM 2	ITC 2	QM18	QCJR
2	1000						5
3	1001						10
4	1000						3
5	1000						7
6	1001						11
7	1002						13
TEST

Output?

	A	B
1	ITEM NO	QCJR
2	1000	15
3	1001	21
4	1002	13
RECON

 

[roykana]

I think you're trying to do a simple SUMIF, like this perhaps? If I'm correct, your code can be made much simpler.

Input

	A	B	C	D	E	F	G
1	ITEM NO	ITEM 1	ITC 1	ITEM 2	ITC 2	QM18	QCJR
2	1000						5
3	1001						10
4	1000						3
5	1000						7
6	1001						11
7	1002						13
TEST

Output?

	A	B
1	ITEM NO	QCJR
2	1000	15
3	1001	21
4	1002	13
RECON

@StephenCrump
That's right. Actually previously the code was used for multi sheet for sumif and sumifs but I have eliminated other codes but certainly in the future for multi sheet and multi criteris. If you can modify it a little it's better. Maybe if you have better recommendations but still use arrays and dictionaries so that it is faster

 

[StephenCrump]

Using my layout in Post #2, try:

Sub Test()

    Dim vIn As Variant
    Dim dic As Object
    Dim i As Long
    Const COL = 7   'column G
        
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare

    With Worksheets("TEST")
        vIn = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Resize(, COL).Value2
    End With

    For i = 1 To UBound(vIn)
        dic(vIn(i, 1)) = dic(vIn(i, 1)) + vIn(i, COL)
    Next i
    
    With Worksheets("RECON").Range("A2").Resize(dic.Count)
        .Value = Application.Transpose(dic.Keys)
        .Offset(, 1).Value = Application.Transpose(dic.Items)
    End With
    
End Sub

 

[roykana]

Using my layout in Post #2, try:

Sub Test()

    Dim vIn As Variant
    Dim dic As Object
    Dim i As Long
    Const COL = 7   'column G
      
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare

    With Worksheets("TEST")
        vIn = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Resize(, COL).Value2
    End With

    For i = 1 To UBound(vIn)
        dic(vIn(i, 1)) = dic(vIn(i, 1)) + vIn(i, COL)
    Next i
  
    With Worksheets("RECON").Range("A2").Resize(dic.Count)
        .Value = Application.Transpose(dic.Keys)
        .Offset(, 1).Value = Application.Transpose(dic.Items)
    End With
  
End Sub

@StephenCrump
I've tried the code successfully but if I try for 100000 records there is an error (run time error 13) in the code below
is there a limit and I also attach screenshots.

        .Value = Application.Transpose(dic.Keys)

 

[StephenCrump]

Yes, too many to TRANSPOSE.

Try:

Sub Test()

    Dim vIn As Variant, vOut As Variant, key As Variant
    Dim dic As Object
    Dim i As Long
    Const COL = 7   'column G
        
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare

    With Worksheets("TEST")
        vIn = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Resize(, COL).Value2
    End With

    For i = 1 To UBound(vIn)
        dic(vIn(i, 1)) = dic(vIn(i, 1)) + vIn(i, COL)
    Next i
    
    ReDim vOut(1 To dic.Count, 1 To 2)
    i = 1
    For Each key In dic.keys
        vOut(i, 1) = key
        vOut(i, 2) = dic(key)
        i = i + 1
    Next key
    Worksheets("RECON").Range("A2").Resize(dic.Count, 2).Value = vOut
    
End Sub

 

[roykana]

Yes, too many to TRANSPOSE.

Try:

Sub Test()

    Dim vIn As Variant, vOut As Variant, key As Variant
    Dim dic As Object
    Dim i As Long
    Const COL = 7   'column G
       
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare

    With Worksheets("TEST")
        vIn = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Resize(, COL).Value2
    End With

    For i = 1 To UBound(vIn)
        dic(vIn(i, 1)) = dic(vIn(i, 1)) + vIn(i, COL)
    Next i
   
    ReDim vOut(1 To dic.Count, 1 To 2)
    i = 1
    For Each key In dic.keys
        vOut(i, 1) = key
        vOut(i, 2) = dic(key)
        i = i + 1
    Next key
    Worksheets("RECON").Range("A2").Resize(dic.Count, 2).Value = vOut
   
End Sub

@StephenCrump
Thanks for the reply from you, sorry if I'm late reply, it went perfectly.
from your code I want to do multi source with sumif & sumifs, for the yellow color that is in the source it is the value (sum_range) and for the orange color that is in the source it is a criterion. For the sheet "RECON" that I mark the blue color it is the desired result and also I use the formula so that it is easy to understand.

thanks
roykana

Source1

problem sumif.xlsm
	A	B	C	D	E	F	G
1	ITEM NO	ITEM 1	ITC 1	ITEM 2	ITC 2	QM18	QCJR
2	1000	TEST R 1000	0-1000	TEST RR 1000	0-1000-0	5	5
3	1001	TEST R 1001	0-1001	TEST RR 1001	0-1001-0	10	10
4						15	15
TEST

Cell Formulas
Range	Formula
F4	F4	=SUBTOTAL(109,[QM18])
G4	G4	=SUBTOTAL(109,[QCJR])

Source2

problem sumif.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	PNM	ITM	ITC	QTY	UNI	CIU	NOD	DPR	NCUR	QAB	GLB	DPT	DATE	SAC	DEPT	TRANS	ITEM NO
2	U-1000	TEST R 1000	1000	10									05-02-22	1	M01	PURCHASE	1000
3	U-1001	TEST R 1001	1001	15									05-02-22	2	N01	PURCHASE	1001
4	U-1002	TEST R 1000	1000	13									05-02-22	3	O01	PURCHASE	1000
5	U-1003	TEST R 1001	1001	12									05-02-22	4	P01	PURCHASE	1001
6	U-1004	TEST R 1000	1000	11									05-02-22	5	M01	SALES	1000
7	U-1005	TEST R 1001	1001	13									05-02-22	6	N01	SALES	1001
8	U-1006	TEST R 1000	1000	15									05-02-22	7	O01	SALES	1000
9	U-1007	TEST R 1001	1001	18									05-02-22	8	P01	SALES	1001
10				107
MUTATION

Cell Formulas
Range	Formula
D10	D10	=SUBTOTAL(109,[QTY])

Source3

problem sumif.xlsm
	A	B	C	D	E	F	G
1	ITC	ITM	QFSK	INV	REMARK	ITEM NO	GROUP
2	1000	TEST R 1000	10			1000	BOJ
3	1001	TEST R 1001	15			1001	M18
4	1003	TEST R 1003	25			1003	BOJ
5	1000	TEST R 1000	11			1000	CJR
6	1001	TEST R 1001	12			1001	CJR
7			73
MUTATION1

Cell Formulas
Range	Formula
C7	C7	=SUBTOTAL(109,[QFSK])

Desired result

problem sumif.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	ITEM NO	QJR	PURCHASE				SALES				BOJ	CJR	M18
2			M01	N01	O01	P01	M01	N01	O01	P01
3	1000	5	10	0	13	0	11	0	15	0	10	11	0
4	1001	10	0	15	0	12	0	13	0	18	0	12	15
5		65	10	15	13	12	11	13	15	18	10	23	15
RECON

Cell Formulas
Range	Formula
C3:F4	C3	=SUMIFS(MUTATION[QTY],MUTATION[ITEM NO],$A3,MUTATION[TRANS],RECON!$C$1,MUTATION[DEPT],RECON!C$2)
G3:J4	G3	=SUMIFS(MUTATION[QTY],MUTATION[ITEM NO],$A3,MUTATION[TRANS],RECON!$G$1,MUTATION[DEPT],RECON!G$2)
K3:M4	K3	=SUMIFS(MUTATION1[QFSK],MUTATION1[ITEM NO],RECON!$A3,MUTATION1[GROUP],RECON!K$1)
C5:M5	C5	=SUM(C3:C4)

 

[StephenCrump]

That's great, I'm glad it worked for you.

Sorry, I don't have the time for your follow up question - it will require quite a bit more work to implement in VBA. Normally I'd suggest starting a new thread, but I see that you have already started several similar threads recently.

Bottom line: if your workbook is so unwieldy that you think you should replace all your (dynamic) Excel formulae with (static) VBA results, you probably should be using alternatives such as Power Pivot.

 

[roykana]

That's great, I'm glad it worked for you.

Sorry, I don't have the time for your follow up question - it will require quite a bit more work to implement in VBA. Normally I'd suggest starting a new thread, but I see that you have already started several similar threads recently.

Bottom line: if your workbook is so unwieldy that you think you should replace all your (dynamic) Excel formulae with (static) VBA results, you probably should be using alternatives such as Power Pivot.

@StephenCrump
Thank you for your reply. if using the code below then I can do multi source as I want, so I want the code structure below does not need to be changed just modify a little so that the result can be the same as the output I want

Option Explicit

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
  
  'TEST
  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 7 to column 7
      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