reduce code execution time

Sub test() 
    Dim a, i As Long, ii As Long, dic As Object, w, e, s 
    Dim StartDate As Date, EndDate As Date 
    Set dic = CreateObject("Scripting.Dictionary")
    ' use dic as a "mother dictionary" object to store unique "Employee" info. 
    dic.CompareMode = 1
    ' set compare mode to case-insensitive.
    a = Sheets("temp calc").Cells(1).CurrentRegion.Value
    ' store whole data in "Temp Calc" to variable "a" to speed up the process.
    For i = 2 To UBound(a, 1) 
    ' commence loop from row 2.
        If Not dic.exists(a(i, 1)) Then 
            Set dic(a(i, 1)) = CreateObject("Scripting.Dictionary")
            ' set child dictionary to each unique "Emp Id"
        End If 
        If Not dic(a(i, 1)).exists(a(i, 3)) Then 
            Set dic(a(i, 1))(a(i, 3)) = _ 
            CreateObject("Scripting.Dictionary")
            ' set child child dictionary to each unique "Startdt" to unique "Emp Id"
        End If 
        dic(a(i, 1))(a(i, 3))(a(i, 4)) = dic(a(i, 1))(a(i, 3))(a(i, 4)) + 1
        ' add 1(count) to a unique set of "Emp Id", "Startdt" and "Finishdt", so that it enables to count as
        ' different match even if multiple same unique set of "Emp Id", "Startdt" and "Finishdt" appears.
    Next 
    With Sheets("dashboard") 
        StartDate = .[N1].Value: EndDate = .[N2].Value 
        With .Range("a3").CurrentRegion.Resize(, .Rows(3).Find("*", , , , xlByRows, xlPrevious).Column)
            ' finding the data range, cos you have blank column within the data range.
            .Columns("q").Resize(.Rows.count - 3, .Columns.count - 16).Offset(3).Value = 0
            ' initialize the values in result range set to "0".
            a = .Value
            ' store whole data range to an array "a"
            For i = 4 To UBound(a, 1)
            ' commence loop from row 4.
                If dic.exists(a(i, 1)) Then
                 ' when mother dictionary finds "Employee"
                    For Each e In dic(a(i, 1)) 
                     ' loop each "Startdt"
                        For Each s In dic(a(i, 1))(e)
                        ' loop corresponding "Finishdt"
                            If (e <= EndDate) * (s >= StartDate) Then
                            ' when "Startdt" <= EndDate and "Finishdt" >= StartDate
                                For ii = 17 To UBound(a, 2)
                                ' commence loop from col.Q
                                    If (a(3, ii) >= e) * (s >= a(3, ii)) Then 
                                    ' when date in the list matches to date between "Startdt" and "Finishdt"
                                        a(i, ii) = a(i, ii) + dic(a(i, 1))(e)(s)
                                        ' add its count to corresponding place in array "a"
                                    End If 
                                Next 
                            End If 
                        Next 
                    Next 
                End If 
            Next 
            .Value = a
            ' dump whole data to a range.
        End With 
    End With 
End Sub