Array calculations instead of SUMPRODUCT

[aethere92]

Hello,

I have a workbook I'm using as a tracker of how many tasks were done in each day of the year. Each week has its own worksheet (and is named by the week's number - e.g. "35" if the dates covered are between the 21st and 27th of August).

(Tracker sheet)
[TABLE="class: grid, width: 35"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Tasks/Date[/TD]
[TD="align: center"]21/08/2017[/TD]
[TD="align: center"]22/08/2017[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Task_1[/TD]
[TD]=SUMPRODUCT(('35'!$C$1:$E$4=$A2)*('35'!$A$1:$A$4=B$1))[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Task_2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

(week "35" sheet)
[TABLE="class: grid, width: 50, align: left"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]21/08/2017[/TD]
[TD]08:00[/TD]
[TD][/TD]
[TD]Task_1[/TD]
[TD]Task_2[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]21/08/2017[/TD]
[TD]09:00[/TD]
[TD]Task_2[/TD]
[TD]Task_1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]22/08/2017[/TD]
[TD]08:00[/TD]
[TD]Task_1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]22/08/2017[/TD]
[TD]09:00[/TD]
[TD]Task_2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]









So what I need to do is track how many times in each day each task appears. The SUMPRODUCT formula I've listed in B2 in the Tracker sheet works just fine, however, it is very slow.

I've managed to make it work with VBA by using the Cell.Value2 = Evaluate, but it still takes like 5-6 seconds to do it, and from what I've read, doing the calculations in an array and them pasting the results to the table should take way less than that.

The exact code for the evaluate is as follows:

Set rng = Sheets("Tracker").Range("D6:EM" & Range("C999").End(xlUp).Row)

For Each cell In rng
If Not Cells(cell.Row, 3).Value Like "*Planned*" And Not Cells(cell.Row, 3).Value Like "*all_*" And (Cells(cell.Row, 3).Value Like "X1_*" Or Cells(cell.Row, 3).Value Like "PM_*") Then
    cell.Value2 = Evaluate("IFERROR(SUMPRODUCT((" & Cells(1, cell.Column).Value & "!$F$6:$BM$102=" & Cells(cell.Row, 3).Address & ")*(" & Cells(1, cell.Column).Value & "!$D$6:$D$102=" & Cells(4, cell.Column).Address & "))/8,0)")
End If
Next

One thing, the format needs to stay this way, and I cannot use PivotTables...

I'd really appreciate if anyone could help me with a solution to reduce the calculation times on this.

Thanks!

 

[Jonmo1]

Try this formula entered as an array with CTRL + SHIFT + ENTER

=SUM(IF('35'!$C$1:$E$4=$A2,IF('35'!$A$1:$A$4=B$1,1,0)))

 

[aethere92]

Hey JackDanIce, you're the MVP it works like a charm on the mock-up. I already feel like I'm asking too much, but would you be so kind to tell me how to manipulate the code so I can adjust it for the main sheet I have? I'm mainly interested on how I would extend and shrink the ranges it looks at

 

[JackDanIce]

Thank you but, no way near yet MVP level, that's @Jonmo1 who replied above! Did you attempt his non-VBA solution?

Sub Macro1()

    Dim x       As Long
    Dim y       As Long
    Dim arr()   As Variant

    With Sheets("Tracker")
        x = .Cells(.Rows.Count, 2).End(xlUp).row
        arr = .Cells(1, 2).Resize(x, 52).Value
        
        For x = LBound(arr, 1) + 4 To UBound(arr, 1)
            On Error Resume Next
            For y = LBound(arr, 2) + 2 To UBound(arr, 2)
                arr(x, y) = MySUMPRODUCT(Sheets(arr(2, y)), CDate(arr(4, y)), CStr(arr(x, 1)))
            Next y
            On Error GoTo 0
        Next x


        .Cells(1, 2).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End With
    Erase arr


End Sub


Private Function MySUMPRODUCT(ByRef wks As Worksheet, ByRef Dte As Date, ByRef strTask As String) As Double


    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
    
    MySUMPRODUCT = 0
    
    With wks
        arr = .Cells(6, 4).Resize(97, 62).Value
        For x = LBound(arr, 1) To UBound(arr, 1)
            On Error Resume Next
            For y = LBound(arr, 2) + 2 To UBound(arr, 2)
                MySUMPRODUCT = MySUMPRODUCT + (--(CStr(arr(x, y)) = strTask) * --(CDate(arr(x, 1)) = Dte))
            Next y
            On Error GoTo 0
        Next x
    End With
    Erase arr
    
    MySUMPRODUCT = MySUMPRODUCT * 0.125
    
End Function

x is the last row with data in column B on sheet Tracker
52 is the count of the number of weeks (number of columns) in sheet Tracker, where column B is your first column (52 weeks in a year is the assumption here)
.Cells(6, 4).Resize(97, 62) is the range on each non Tracker sheet the code evaluates, for area D6:BM102 for that week's sheet