T3925_Unique In Three Columns SUM Total By Dictionary

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

Sub Unique_In_Three_Columns_SUM_Total_By_Dictionary()
    Dim a, e, ws As Worksheet, sh As Worksheet, dic As Object, s As String, i As Long

    Set ws = ThisWorkbook.Sheets(1)
    Set sh = ThisWorkbook.Sheets(2)
    Set dic = CreateObject("Scripting.Dictionary")

    For Each e In Array(0, 1)
        If e = 0 Then
            a = ws.Range("B5:E" & ws.Cells(Rows.Count, "B").End(xlUp).Row).Value
        Else
            a = sh.Range("C4:F" & sh.Cells(Rows.Count, "C").End(xlUp).Row).Value
        End If

        For i = LBound(a, 1) To UBound(a, 1)
            s = Trim(a(i, 1)) & vbTab & Trim(a(i, 2)) & vbTab & Trim(a(i, 3))
            If Not dic.Exists(s) Then dic(s) = Array(, , , 0)
            dic(s) = Array(Trim(a(i, 1)), Trim(a(i, 2)), Trim(a(i, 3)), dic(s)(3) + Val(a(i, 4)))
        Next i
    Next e

    Application.ScreenUpdating = False
        With sh.Range("K4")
            .Resize(1, 4).Value = Array("الصنف", "النوع", "المنشأ", "الرصيد")
            .Offset(1).Resize(dic.Count, 4).Value = Application.Transpose(Application.Transpose(dic.items))
        End With
    Application.ScreenUpdating = True
End Sub