reference link Sumifs VBA with multiple criteria in multiple cells
I ask for help to modify the vba code so that I can use it in the file I attached with it.
I see the sumifs vba code that you created is very fast because I need to record thousands of records.
The results I want are in the "resultformula" sheet and the VBA results in sheet2.
link file : Sumifsfast.xlsm
https://drive.google.com/file/d/1KTWFyKpLLWQ3GOpfJajZpnzMPZgDBxOg/view?usp=sharing
Thanks
roykana
I ask for help to modify the vba code so that I can use it in the file I attached with it.
I see the sumifs vba code that you created is very fast because I need to record thousands of records.
The results I want are in the "resultformula" sheet and the VBA results in sheet2.
link file : Sumifsfast.xlsm
https://drive.google.com/file/d/1KTWFyKpLLWQ3GOpfJajZpnzMPZgDBxOg/view?usp=sharing
Thanks
roykana
VBA Code:
Sub sumiffast()
Dim dDate As Object, dCode As Object
Dim vData As Variant, i As Long
t = Timer
Set dDate = CreateObject("Scripting.Dictionary")
dDate.CompareMode = vbTextCompare
Set dCode = CreateObject("Scripting.Dictionary")
dCode.CompareMode = vbTextCompare
'Data in Sheet1
With Sheets("Sheet1")
vData = .Range("A2:F" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With
For i = LBound(vData, 1) To UBound(vData, 1)
dCode(vData(i, 2)) = vData(i, 3)
If dDate.exists(vData(i, 1)) Then
dDate(vData(i, 1))(vData(i, 2)) = dDate(vData(i, 1))(vData(i, 2)) + vData(i, 4)
Else
Set dDate(vData(i, 1)) = CreateObject("Scripting.Dictionary")
dDate(vData(i, 1))(vData(i, 2)) = vData(i, 4)
End If
Next i
'Results in Sheet2
Dim vResult As Variant, j As Long
With Sheets("Sheet2")
.Range("A1:B1") = Array("Code", "Name")
.Range("A2").Resize(dCode.Count, 2) = Application.Transpose(Array(dCode.keys, dCode.items))
.Range("C1").Resize(, dDate.Count) = dDate.keys
vResult = .Range("A1").Resize(dCode.Count + 1, dDate.Count + 2)
For i = LBound(vResult, 1) + 1 To UBound(vResult, 1)
For j = LBound(vResult, 2) + 2 To UBound(vResult, 2)
vResult(i, j) = dDate(vResult(1, j))(vResult(i, 1))
Next j
Next i
.Range("A1").Resize(dCode.Count + 1, dDate.Count + 2) = vResult
.Columns("C").Resize(, dDate.Count).AutoFit
End With
Debug.Print "It's done in: " & Timer - t & " seconds"
End Sub
Last edited by a moderator: