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.

 

[kuldar]

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

Hello igold! Your code helped me out with very difficult task I have to solve. But I have one issue with pasted dates - sometimes when change query in SQL which give me the dates on sheet1 and get this pasted to sheet2 the dates are not in ascending order after pasting, sometimes are. Can you help with this to ensure that the dates are always in correct order? Thank you in advance!

 

[igold]

Hi kuldar, welcome to the MrExcel forum.

In the future it is preferred, and more advantageous if you start a new thread with your question and not tack on to the bottom of an existing thread.

Without seeing any data, the first question I would ask is- can you sort the data before moving it...

 

[kuldar]

Hi kuldar, welcome to the MrExcel forum.

In the future it is preferred, and more advantageous if you start a new thread with your question and not tack on to the bottom of an existing thread.

Without seeing any data, the first question I would ask is- can you sort the data before moving it...

It is not very smart idea to continue the same topic in another thread but keep discussion related to topic together.

All data was posted, I can not sort array before moving. Sorting array 'dts' is necessary because I want to order article numbers ascending as well as dates.

 

[igold]

Ok, how about an example of some data. You may want to use XL2BB. Similar to what the OP of this thread did.