# 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!!!! #### 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``````

1,082,358
Messages
5,364,914
Members
400,815
Latest member
Joaquin Phoenix

### This Week's Hot Topics

• populate from drop list with multiple tables
Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
• Find list of words from sheet2 in sheet1 before a comma and extract text vba
Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
• Dynamic Formula entry - VBA code sought
Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...