Make sumifs with array faster

[ouvay]

Hello all

I've written this bit of code.. it works ... but can anyone help make it faster?

Its basically a sumifs with arrays -problem is that I'm dealing with over 1.2 million rows (600k+ in one table and 600k+ in the sumifs data table) - so it takes a pretty minute

Sub totals_fromHDFC()

    Dim hdfcwb As Workbook: Set hdfcwb = Workbooks.Item("Payment Control - HDFC Leg.xlsm")
    Dim hdfc As Worksheet: Set hdfc = hdfcwb.Worksheets(1)
    Dim a() As Variant
    Dim data2() As Variant
    Dim r As Long, i As Long, NumRows As Long,  s1 As String
 
 
    With Sheet2 ''assigning main data table to an array
    NumRows = .Cells(.Rows.Count, "B").End(xlUp).Row
    data2 = .Range("D1:J" & NumRows).Value
    For i = LBound(data2) To UBound(data2)
        data2(i, 2) = data2(i, 7)
        data2(i, 3) = data2(i, 5)
    Next i
    ReDim Preserve data2(1 To NumRows, 1 To 3) As Variant
    ReDim sum2(2 To NumRows, 1 To 2) As Variant
    s2 = .Name
    End With
 
    With hdfc 'assigning table where I want to sumif, to array
    NumRows = .Cells(.Rows.Count, "B").End(xlUp).Row
    a = .Range("C1:H" & NumRows).Value
    For i = LBound(a) To UBound(a)  ''feel free to ignore this hot mess :)  its just me rearranging my array to suit my preferences
        a(i, 1) = a(i, 4)
        a(i, 4) = a(i, 2)
        a(i, 2) = a(i, 5)
        a(i, 5) = a(i, 3)
        a(i, 3) = a(i, 6)
    Next i
    ReDim Preserve a(1 To NumRows, 1 To 5) As Variant
    ReDim sum2(1 To NumRows, 1 To 2) As Variant
    s2 = .Name
    End With
 

'actual summing happens in this loop
For r = 2 To UBound(data2)
    Application.StatusBar = "Calculating " & s2 & " row " & r & " of " & UBound(data2) & "... " & Format(r / UBound(data2), "PERCENT") & " Completed"  ' just some status bar ux
    For i = LBound(a) To UBound(a)
        If data2(r, 1) = a(i, 1) And data2(r, 2) = a(i, 2) And data2(r, 3) = a(i, 3) Then
            sum2(r, 1) = sum2(r, 1) + a(i, 4)
            sum2(r, 2) = sum2(r, 2) + a(i, 5)
        End If
    Next i
Next r
 
    Sheet2.Range("AD2").Resize(UBound(sum2), 1).Value = sum2
 
End Sub

 

[Alex Blakenburg]

I didn't add Application.ScreenUpdating = False at the beginning and True at the end.
That might make a difference as well.

 

[ouvay]

I didn't add Application.ScreenUpdating = False at the beginning and True at the end.
That might make a difference as well.

I put that in there before running the tests.. total life changer though

I studied your code and converted a some of my other codes to scripting.dictionary too (obviously where it was applicable lol)

been cutting down times left, right and center :D

 

[Alex Blakenburg]

I love it. Nice to hear.