abdo meghari
Active Member
- Joined
- Aug 3, 2021
- Messages
- 471
- Office Version
- 2019
hi
I got this code from some forum, but I don't remember who's owner it because it's long time ago in my PC
I implement the code and works for my data .
now I would expand code when show the result should show the items into column G,H,J,I,K based on range A2:E
I put the simple data to understand me what I want .
orginal data
result
and this is the code
I look forward any one can mod this code.
I got this code from some forum, but I don't remember who's owner it because it's long time ago in my PC
I implement the code and works for my data .
now I would expand code when show the result should show the items into column G,H,J,I,K based on range A2:E
I put the simple data to understand me what I want .
orginal data
MR.xlsm | |||||||
---|---|---|---|---|---|---|---|
A | B | C | D | E | |||
1 | CODE | BRAND | TYPE | ORIGIN | QTY | ||
2 | AA | 1200R20 | G580 | JAP | 55 | ||
3 | AA | 1200R20 | G580 | JAP | 20 | ||
4 | BB | 1400R20 | VSJ | CHI | 30 | ||
5 | BB | 1400R20 | VSJ | CHI | 40 | ||
sheet1 |
result
MR.xlsm | |||||||
---|---|---|---|---|---|---|---|
G | H | I | J | K | |||
1 | CODE | BRAND | TYPE | ORIGIN | QTY | ||
2 | AA | 1200R20 | G580 | JAP | 75 | ||
3 | BB | 1400R20 | VSJ | CHI | 70 | ||
sheet1 |
and this is the code
VBA Code:
Option Base 1
Sub summing_duplicateditems()
Dim Data As Variant, R As Long
Dim QtyDict As Object
Set QtyDict = CreateObject("scripting.dictionary")
Data = Range("A2", Cells(Rows.Count, "D").End(xlUp))
With QtyDict
For R = 1 To UBound(Data)
If Not .Exists(Data(R, 1)) Then 'if no dictionary entry for first column then make a new key...
.Add Data(R, 1), Data(R, 4) 'adding first value
Else
.Item(Data(R, 1)) = .Item(Data(R, 1)) + Data(R, 4) ' if existing dictionary, add new value for that item
End If
Next R
Range("F2:F" & .Count + 1) = Application.Transpose(.Keys) ' added 1 to each count (since reporting totals from row 2)
Range("G2:G" & .Count + 1) = Application.Transpose(.Items)
End With
End Sub