# Getting Unique Ids and from a column and adding corresponding cells

#### geomic788

##### New Member
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!!!! ### Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

#### MikeDBMan

##### Well-known Member
Try this:
Code:
``````Sub Doit()
Dim X, Y As Long
Dim DataArray(50000, 3) As Variant
Dim Fnd As Long
Dim Found As Integer
'start on the sheet with the table, I am assuming is Sheet2.
Sheets("Sheet2").Select  'adjust name of sheet with table as necessary
Application.ScreenUpdating = False
Application.EnableEvents = False
'Application.DisplayAlerts=False  'may not always want to turn this one to false!
Application.Cursor = xlWait
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
X = 2 ' I am assuming the data starts on row 2
Do While True
If Cells(X, 1).Value = Empty Then Exit Do  'assuming if cells in column A is empty then we're done.
Let Found = 0
For Y = 1 To Fnd
If Cells(X, 1).Value = DataArray(Y, 1) Then
Found = 1
Let DataArray(Y, 2) = DataArray(Y, 2) + Cells(X, 2).Value 'add the new quantity
Let DataArray(Y, 3) = DataArray(Y, 3) & ", " & Cells(X, 3).Value
Exit For
End If
Next
If Found = 0 Then
Fnd = Fnd + 1
For Y = 1 To 3
Let DataArray(Fnd, Y) = Cells(X, Y).Value
Next
End If
X = X + 1
Loop
'now when done, go to the sheet to put the summary.  I will add it here
Dim NewWKs As Worksheet
NewWKs.Name = "Summary"
Cells(1, 1).Value = "Product Code"
Cells(1, 2).Value = "Quantity"
Cells(1, 3).Value = "Locations Found"
For X = 2 To Fnd + 1
For Y = 1 To 3
Cells(X, Y).Value = DataArray(X - 1, Y)
Next
Next
Cells.Select
Cells.EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With

Range("A2").Select
Beep
Beep

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Cursor = xlDefault
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With

End Sub``````

#### JoeMo

##### MrExcel MVP
Welcome to the Forum. This will add a sheet named "Summary" where your data will be summarized. The code should be run with your data sheet as the active sheet.
Code:
``````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
On Error Resume Next
Sheets("Summary").Delete
On Error GoTo 0
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", "C" & 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, 2)
Loc = Loc & "," & vA(i, 3)
End If
Next i
c.Offset(0, 1) = Qty
c.Offset(0, 2) = Right(Loc, Len(Loc) - 1)
Next c
rSht.Columns("A:C").AutoFit
End Sub``````

#### geomic788

##### New Member
Thank you very much for your quick replys.I mean u guyes are awesome!I will try to intergrate it on my main project tomorow morning when i get at the office.Right now i checked it on a draft project and it works.Thank you very much!

#### geomic788

##### New Member
Joe Mo i thought of something extra that could cause problems when intergating to the main project.I am a complete VBA noob so some help would be great.
My actual columns are

A:Product Code B:Only numbers from column A( for right sorting) C: Quantity D Stuff already taken off the location.this is useless for our macro) E:Location

Please be so kind to modify the function u made in order to work with the specific columns

Thank u very very much!

#### JoeMo

##### MrExcel MVP
Joe Mo i thought of something extra that could cause problems when intergating to the main project.I am a complete VBA noob so some help would be great.
My actual columns are

A:Product Code B:Only numbers from column A( for right sorting) C: Quantity D Stuff already taken off the location.this is useless for our macro) E:Location

Please be so kind to modify the function u made in order to work with the specific columns

Thank u very very much!
So for the input data you care only about columns A, C and E, is that right? Are the column headers in row 1 of the input sheet? And, do you still want only PrdCode, Qty and Locations on the summary sheet in columns A-C)?

#### geomic788

##### New Member
So for the input data you care only about columns A, C and E, is that right? Are the column headers in row 1 of the input sheet? And, do you still want only PrdCode, Qty and Locations on the summary sheet in columns A-C)?
Yes that is correct.Will the results be sortable?Or should i sort the data beforehand ?

#### JoeMo

##### MrExcel MVP
Yes that is correct.Will the results be sortable?Or should i sort the data beforehand ?
The data do not need to be sorted. A sort of the summary data can be added to the code - what column(s) do you want to sort on. Ascending or descending?

#### geomic788

##### New Member
The data do not need to be sorted. A sort of the summary data can be added to the code - what column(s) do you want to sort on. Ascending or descending?
I am at the office now so i can see my main project and check everything.I made a mistake.
The columns that i am interested in are A D and F.The sorting part is kinda tricky cause we have multiple formats of product codes as in :
4001
4002
4001S
27425
27484S
4357s7

These should be sorted like this:
4001
4001S
4002
4357s7
27425
27484S

If you make the macro please make it separately so i can use it on my input data as well so i can avoid sorting it with the helper column which makes all the codes of the format 4357s7 i mean the ones that doesent end with a letter end up in the end.
Man thank you so much for doing all these for me

#### JoeMo

##### MrExcel MVP
You can remove the sort at the end of this code if it doesn't sort in the order you want.
Code:
``````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
On Error Resume Next
Sheets("Summary").Delete
On Error GoTo 0
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
End With
End Sub``````