VBA Sum Multiple Columns and Duplicate Rows

[drawde07]

Hi! I am new here and just started learning vba codes.

I was wondering, I have searched alot but Could not find a specific code where I would be able to sum the A column of the duplicates of B to D columns and deleting the duplicates.

The original Data would be like
QTY UOM ITEMS BRAND
60 Meters 8.0mm wire - Red Duraflex
2 Boxes Grinding Disc Stanley
1 Kilos Item 3 Brand 3
5 Meters Grinding Disc Brand 3
-10 Meters 8.0mm wire - Red Duraflex

And after using the Code it would be
50 Meters 8.0mm wire - Red Duraflex
2 Boxes Grinding Disc Stanley
1 Kilos Item 3 Brand 3
5 Meters Grinding Disc Brand 3

I found different codes but all of the ones that would be summed will be at the right and only used 2/3 columns , I cannot find where it would be left and many columns.
Thank you!

 

[drawde07]

Please note that these are ranges and not tables

 

[bebo021999]

With data from A1:D1 downwards.
Copy this code into an available module (Alt-F11, insert/modules)

Option Explicit
Sub test()
Dim lr&, i&, rng, id As String, arr()
Dim dic As Object, key
Set dic = CreateObject("Scripting.dictionary")
lr = Cells(Rows.Count, "D").End(xlUp).Row
rng = Range("A2:D" & lr).Value
For i = 1 To lr - 1
    id = rng(i, 2) & "|" & rng(i, 3) & "|" & rng(i, 4)
    If Not dic.exists(id) Then
        dic.Add id, rng(i, 1)
    Else
        dic(id) = dic(id) + rng(i, 1)
    End If
Next
i = 0
ReDim arr(1 To dic.Count, 1 To 4)
For Each key In dic.keys
    i = i + 1
    arr(i, 1) = dic(key)
    arr(i, 2) = Split(key, "|")(0)
    arr(i, 3) = Split(key, "|")(1)
    arr(i, 4) = Split(key, "|")(2)
Next
Range("A2:D10000").ClearContents
Range("A2").Resize(UBound(arr), 4).Value = arr
End Sub

 

[drawde07]

Thanks alot!
This helped me by 100000x!
Really Appreciated

With data from A1:D1 downwards.
Copy this code into an available module (Alt-F11, insert/modules)

Option Explicit
Sub test()
Dim lr&, i&, rng, id As String, arr()
Dim dic As Object, key
Set dic = CreateObject("Scripting.dictionary")
lr = Cells(Rows.Count, "D").End(xlUp).Row
rng = Range("A2:D" & lr).Value
For i = 1 To lr - 1
    id = rng(i, 2) & "|" & rng(i, 3) & "|" & rng(i, 4)
    If Not dic.exists(id) Then
        dic.Add id, rng(i, 1)
    Else
        dic(id) = dic(id) + rng(i, 1)
    End If
Next
i = 0
ReDim arr(1 To dic.Count, 1 To 4)
For Each key In dic.keys
    i = i + 1
    arr(i, 1) = dic(key)
    arr(i, 2) = Split(key, "|")(0)
    arr(i, 3) = Split(key, "|")(1)
    arr(i, 4) = Split(key, "|")(2)
Next
Range("A2:D10000").ClearContents
Range("A2").Resize(UBound(arr), 4).Value = arr
End Sub

View attachment 69174