Getting Unique Ids and from a column and adding corresponding cells

[geomic788]

Hello!
Thank you for this amazing Forum!
Im having some sort of trouble in excel
Here's the situation

I ve got a really long column (3000 entries) with product codes and corresponding quantities.Since each product can be found in different locations there are multiple entries of the same product code.So i need a way to sum up all the quantities in a different sheet next to a list

1st Table

PrdCode Quantity Location
4001 2 5
4001 5 2
4001s 11 15
17403s 3 5
17403s 1 8
4001 2 1
4001s 12 12

Desired Result in different sheet
PrdCode Quantity Locations
4001 9 5,2,1
4001s 23 12,15
17403s 4 5,8


I know the Locations with commas is a bit too much to ask and mabye really complicated.The first part would be awesome as well.Just sums per product code would be great.

Thank you!!!!

 

[geomic788]

You can remove the sort at the end of this code if it doesn't sort in the order you want.

Sub Geomic()
'Run from the data sheet
Dim lRs As Long, lRr As Long, Qty As Long, Loc As String, sSht _
    As Worksheet, rSht As Worksheet, c As Range, vA As Variant
    
Set sSht = ActiveSheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Summary").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set rSht = Sheets.Add(after:=sSht)
rSht.Name = "Summary"
rSht.Range("B1:C1").Value = Array("Quantity", "Location")
sSht.Select
lRs = Range("A" & Rows.Count).End(xlUp).Row
Range("A1", "A" & lRs).AdvancedFilter Action:=xlFilterCopy, copytorange:=rSht.Range("A1"), unique:=True
lRr = rSht.Range("A" & Rows.Count).End(xlUp).Row
vA = sSht.Range("A2", "F" & lRs)
For Each c In rSht.Range("A2", "A" & lRr)
    Qty = 0
    Loc = ""
    For i = LBound(vA, 1) To UBound(vA, 1)
        If vA(i, 1) = c.Value Then
            Qty = Qty + vA(i, 4)
            Loc = Loc & "," & vA(i, 6)
        End If
    Next i
    c.Offset(0, 1) = Qty
    c.Offset(0, 2) = Right(Loc, Len(Loc) - 1)
Next c
With rSht
    .Select
    .Columns("A:C").AutoFit
    .Range("A1").CurrentRegion.Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
End With
End Sub

I am getting a mismatch at line 13

Qty = Qty + vA(i, 4)

Any suggestions ?

 

[JoeMo]

I am getting a mismatch at line 13

Qty = Qty + vA(i, 4)

Any suggestions ?

What's in column D for the data sheet? You could save us both a lot of time if you would post a sample of the data layout.

 

[geomic788]

What's in column D for the data sheet? You could save us both a lot of time if you would post a sample of the data layout.

Yes you are right.I found the mistake.There were 2 questionmarks in a Product code i column D.Removed them and it worked!Thank you very much for all the help you provided!