Обновление данных в Dictionary

For Each cell In rngOut.Rows
        material = cell.Cells(1, 3).Value
        quantity = cell.Cells(1, 4).Value
        dateOut = CDate(cell.Cells(1, 1).Value)
 
        If Not dict.Exists(material) Then
            dict.Add material, Array(quantity, dateOut)
        Else
            If dateOut < CDate(dict(material)(1)) Then
                dict(material)(1) = CDate(dateOut)
            End If
            dict(material)(0) = CLng(dict(material)(0)) + quantity
        End If
    Next cell

    strSql = "SELECT F3, Sum(F4) AS SumOfF4, Min(F1) AS MinOfF1 " & _
             "FROM [Out$A3:E" & lVal & "] WHERE (F4>0) GROUP BY F3;"

Sub MMM()
    Set wsOut = ThisWorkbook.Sheets("Out")
    Set wsIn = ThisWorkbook.Sheets("Temp")
   rngOut = wsOut.Range("A4:E" & wsOut.Cells(wsOut.Rows.Count, "E").End(xlUp).Row).Value
   With CreateObject("Scripting.Dictionary")
         For i = 1 To UBound(rngOut)
                el = .Item(CStr(rngOut(i, 3)))
        Next
        ReDim arr(1 To .Count, 1 To 3)
        For i = 0 To .Count - 1
        dt = 9000000000#
            For j = 1 To UBound(rngOut)
                If .Keys()(i) = rngOut(j, 3) Then
                        arr(i + 1, 1) = rngOut(j, 3)
                       If rngOut(j, 1) < dt Then
                                dt = rngOut(j, 1)
                                arr(i + 1, 2) = arr(i + 1, 2) + rngOut(j, 4)
                                arr(i + 1, 3) = rngOut(j, 1)
                        End If
                End If
            Next
        Next
     wsIn.Cells(3, 3).Resize(UBound(arr), 3).Value = arr
   End With
End Sub

    strSql = "SELECT F3, Sum(F4) AS SumOfF4, Min(F1) AS MinOfF1 " & _
             "FROM [Out$A3:E" & lVal & "] WHERE (F3 Is Not Null) GROUP BY F3;"

Тест из 1 повторов - 5 000 записей:
01. Sub test01()........................................... Продолжительность: 00:00:00.171
02. Sub MMM().............................................. Продолжительность: 00:00:05.746

Sub tt()
 
Dim dict As Object, rngOut
Set rngOut = [a4].CurrentRegion
Set dict = CreateObject("Scripting.Dictionary")
 
For Each cell In rngOut.Rows
        material = cell.Cells(1, 3).Value
        quantity = cell.Cells(1, 4).Value
        dateOut = CDate(cell.Cells(1, 1).Value)
 
        If Not dict.Exists(material) Then
            dict.Add material, Array(quantity, dateOut)
        Else
            If dateOut < CDate(dict(material)(1)) Then
            arr = dict(material)
                arr(1) = CDate(dateOut)
                dict(material) = arr
            End If
            arr = dict(material)
            arr(0) = CLng(arr(0)) + quantity
            dict(material) = arr
        End If
    Next cell
    
  For Each k In dict
  arr = dict(k) 'arr смотреть здесь
  Next
End Sub

      quantity = Val(dict(material)(0)) + Val(quantity)
           dict.Remove material
           dict.Add material, Array(quantity, dateOut)

Sub tt2dict()
 
Dim dict1 As Object, dict2 As Object, rngOut
 
Set rngOut = [a4].CurrentRegion
Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")
 
For Each cell In rngOut.Rows
 
    material = cell.Cells(1, 3).Value
    quantity = cell.Cells(1, 4).Value
    dateOut = CDate(cell.Cells(1, 1).Value)
 
    dict1(material) = WorksheetFunction.Max(dict1(material), dateOut)
    dict2(material) = dict2(material) + quantity
 
Next cell
    
'и выгрузка для проверки, с форматом дат не заморачивался
 With Workbooks.Add(1).Sheets(1)
 .Cells(1, 1).Resize(dict1.Count, 1) = Application.Transpose(dict1.items)
 .Cells(1, 2).Resize(dict1.Count, 1) = Application.Transpose(dict1.keys)
 .Cells(1, 3).Resize(dict2.Count, 1) = Application.Transpose(dict2.items)
 End With
 
End Sub

    If dict1.exists(material) Then
        dict1(material) = WorksheetFunction.Min(dict1(material), dateOut)
    Else
        dict1(material) = dateOut
    End If

Sub Igor_AIR()
    Const r1 As String = "A4"
    Const rDt As String = "A4"
    Const rMat As String = "C4"
    Const rM As String = "D4"
    Const rRez As String = "C2"
    
    Dim wsOut As Worksheet: Set wsOut = ThisWorkbook.Sheets("Out")
    Dim wsIn As Worksheet: Set wsIn = ThisWorkbook.Sheets("Temp")
    Dim rngOut As Range, rngIn As Range
    Dim All, key, dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i, i1, iL, iDt, iMat, iM
    Dim ttt: ttt = Timer
    
    All = wsOut.Range(r1 + ":" + Split(wsOut.UsedRange.Address, ":")(1))
    iL = LBound(All, 1)
    
    i1 = Range(r1).Column
    iDt = Range(rDt).Column - i1 + iL
    iMat = Range(rMat).Column - i1 + iL
    iM = Range(rM).Column - i1 + iL
    
    For i = UBound(All, 1) To iL Step -1
        If dict.Exists(All(i, iMat)) Then
            If All(i, iDt) > dict(All(i, iMat))(0) Then
                dict(All(i, iMat)) = Array(All(i, iDt), dict(All(i, iMat))(1) + All(i, iM))
            Else
                dict(All(i, iMat)) = Array(dict(All(i, iMat))(0), dict(All(i, iMat))(1) + All(i, iM))
            End If
        Else
            dict.Add All(i, iMat), Array(All(i, iDt), All(i, iM))
        End If
    Next
    ReDim All(dict.Count - 1, 2)
    i = 0
    For Each key In dict.Keys
        All(i, 0) = key
        All(i, 1) = dict(key)(1)
        All(i, 2) = dict(key)(0)
        i = i + 1
    Next
    wsIn.UsedRange.ClearContents
    wsIn.Range(rRez).Resize(dict.Count, 3) = All
    
MsgBox "Готово!" & Timer - ttt, vbInformation
End Sub