T3788_SUM TOTAL Unique Dates By Dictionary

https://excel-egy.com/forum/t3788
---------------------------------

Sub SUM_TOTAL_Unqiue_Dates_By_Dictionary()
    Dim a, dic As Object, d As Date, i As Long

    Application.ScreenUpdating = False
        With Worksheets(1)
            a = .Range("G2:I" & .Cells(Rows.Count, 9).End(xlUp).Row).Value
            Set dic = CreateObject("Scripting.Dictionary")

            For i = LBound(a, 1) To UBound(a, 1)
                If Not IsEmpty(a(i, 3)) Then
                    d = DateValue(Replace(Split(a(i, 3))(0), ".", "/"))
                    If Not dic.Exists(d) Then dic(d) = Array(, 0)
                    dic(d) = Array(d, dic(d)(1) + Val(a(i, 1)))
                End If
            Next i

            .Range("S2").Resize(dic.Count, 2).Value = Application.Transpose(Application.Transpose(dic.items))
            With .Range("P3:P33")
                .Formula = "=IFERROR(INDEX(T:T,MATCH(O3,S:S,0)),"""")"
                .Value = .Value
            End With
            .Columns("S:T").Clear
        End With
    Application.ScreenUpdating = True
End Sub