T3623_SUM Similar Items SUM Unique In Three Columns

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

Sub SUM_Similar_Items_SUM_Unique_In_Three_Columns_Dictionary()
    Dim a, ws As Worksheet, i As Long, ii As Long, txt As String

    Set ws = ThisWorkbook.Worksheets("ITEMS")
    a = ws.ListObjects(1).DataBodyRange.Value

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a, 1)
            If a(i, 1) <> "" Then
                txt = Join(Array(a(i, 1), a(i, 2), a(i, 3)), Chr(2))
                If Not .Exists(txt) Then
                    .Item(txt) = .Count + 1
                    For ii = 1 To UBound(a, 2)
                        a(.Count, ii) = a(i, ii)
                    Next ii
                Else
                    For ii = 4 To 7
                        a(.Item(txt), ii) = a(.Item(txt), ii) + a(i, ii)
                    Next ii
                End If
            End If
        Next i
        i = .Count
    End With

    ws.ListObjects(1).DataBodyRange.ClearContents
    ws.Range("B2").Resize(i, UBound(a, 2)) = a
End Sub