Sumifs VBA with multiple criteria in multiple cells

[xs4amit]

Hi Excel Champs,

Please help me getting this calculated

I have data like this

Date	Emp Code	Emp Name	Productivity	AHT
15-02-2018	726462	ABC	254	10 Min
15-02-2018	734840	DEF	123	12 Min
15-02-2018	746569	GHI	656	3 Min
15-02-2018	726462	ABC	153	20 Min
15-02-2018	734840	DEF	345	6 Min
15-02-2018	746569	GHI	234	10 Min
15-02-2018	726462	ABC	484	5 Min
15-02-2018	734840	DEF	556	2 Min
16-02-2018	726462	ABC	645	12 Min
16-02-2018	746569	GHI	937	2 Min
16-02-2018	734840	DEF	294	10 Min
16-02-2018	734840	DEF	475	5 Min
16-02-2018	746569	GHI	284	10 Min

<tbody>
</tbody>

And data goes on for upcoming dates in next Rows.


Where i need to make a productivity report out of above data like this

Emp Code	Emp Name	15-02-2018	16-02-2018	17-02-2018	18-02-2018
726462	ABC	=SUMIFS()	=SUMIFS()
734840	DEF

<tbody>
</tbody>

Right now i am using SUMIFS but my data expands upto 50000 Rows and SUMIFS is very slow. Can you please help me with a VBA code which calculates this for above table.

 

[igold]

Hi,

Are you trying to sum Productivity or AHT.

 

[xs4amit]

Hi,

Are you trying to sum Productivity or AHT.

Hi, i am trying to sum productivity.

 

[igold]

There must be a more elegant way to do this. That said, this code assumes your data is in Sheet1 starting in cell A1. It will write your results to Sheet2 starting in Cell A1..

Sub EmpSum()
    
    Dim ws1 As Worksheet: Set ws1 = Worksheets("Sheet1")
    Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2")
    Dim lRow As Long, x As Long, lRow2 As Long, i As Long, c As Long
    Dim dts As Variant
    
    lRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    dts = ws1.Range("A2:A" & lRow)


    With CreateObject("Scripting.Dictionary")
        For x = LBound(dts) To UBound(dts)
            If Not IsMissing(dts(x, 1)) Then .Item(dts(x, 1)) = 1
        Next
        dts = .Keys
    End With
    
    ws2.Range("C1").Resize(, UBound(dts) + 1) = dts
    ws1.Range("B1:C" & lRow).Copy ws2.Range("A1")
    ws2.Range("A2:B" & lRow).RemoveDuplicates Columns:=Array(1, 2), _
        Header:=xlNo
    lRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    
    For c = 3 To 3 + UBound(dts)
        For i = 2 To lRow2
            ws2.Cells(i, c) = Application.WorksheetFunction.SumIfs _
            (ws1.Range("D:D"), ws1.Range("A:A"), ws2.Cells(1, c), _
            ws1.Range("B:B"), ws2.Range("A" & i))
        Next
    Next
    
End Sub

 

[Marcelo Branco]

If you do not want to use SUMIFS neither in the spreadsheet nor in VBA maybe this macro
Assumes
Data in Sheet1 columns A:F
Results (report) in Sheet2

Sub aTest()
    Dim dDate As Object, dCode As Object
    Dim vData As Variant, i As Long
    
    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
End Sub

M.

 

[igold]

@Marcelo

Your code is obviously- shall we call it "more mature" than my code, so out of curiosity I ran the OP's data down to just over 100K rows and put a timer on both.

I commented out your autofit columns. Your code completed in .37 seconds and much to my surprise my code completed in .19 seconds. I did not expect that result.

igold

 

[Marcelo Branco]

igold

I'm surprised either. Thought SUMIFS would impair the performance with so many rows. Learning every day!

M.

 

[igold]

Perhaps with more diverse data, the results would be different. I only extended what he had and did not add any additional dates or employees. Perhaps If I get ambitious I will try it again with additional unique data...

 

[Marcelo Branco]

Maybe OP can upload his data to a file sharing site and put a link here.
He said he has 50K rows of data and the SUMIFS formulas are very slow - that's why i tried to avoid the same formulas in VBA.

M.

 

[igold]

Yes, that would be interesting to see. Maybe he meant he was manually adding the SUMIFS formulas with every set of new data.

igold