merging duplicate data into one cell

[Punquey]

So, I have a project. don't we all. I need to combine all known UPC codes for a specific part number into a single cell with a semi colon between each UPC code. The data I have is available like this:

1X3 BN	102141
1X3 BN	94913880897
1X3 BN	94913885892
1X3 BN	10668197024406
1X3 BN	20690308000129
1X3 BN	40032888005486
1X3 BN	40032888100457
1X3 BN	585-030
1X3 BN	6818716389800
1X3 BN	94913885892
1X3 BN	AT1X3 BN
1X3 BN	BI1X3 BN

<colgroup><col><col></colgroup><tbody>
</tbody>

How would I combine all of the UPC codes for part number 1x3 BN into a single cell. Note that not all part numbers have same number of UPC codes, it can vary from 1-20. Any help is greatly appreciated.

 

[Fluff]

How about

Sub MergeData()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, 1)
         Else
            .Item(Cl.Value).Value = .Item(Cl.Value).Value & "; " & Cl.Offset(, 1).Value
            Cl.Offset(, 1).ClearContents
         End If
      Next Cl
   End With
   Range("B:B").SpecialCells(xlBlanks).EntireRow.Delete
End Sub

 

[Punquey]

You just broke my brain. So you want me to go and add this code in the VBA design mode, but I'm not sure where.

 

[Fluff]

It needs to go in a regular module. http://www.contextures.com/xlvba01.html

 

[Punquey]

Thank you, I'm giving it a try. 150k items to go through so it may be a while

Gave me time to look at excelapalooza. Do you know if they have a calendar of events/classes yet?

 

[Fluff]

Thank you, I'm giving it a try. 150k items to go through so it may be a while

When working on that amount of data it's usually best to mention it.

Gave me time to look at excelapalooza. Do you know if they have a calendar of events/classes yet?

No idea, I've seen the ads on this site, but that's all.

 

[Punquey]

Lovely. It worked. Thanks so much!!!!

 

[Punquey]

hah. Doesn't everyone work with like a million rows at a time

 

[Fluff]

This should be quicker

Sub MergeData()
   Dim Ary As Variant, Nary As Variant, Ky As Variant
   Dim i As Long
   
   Ary = Range("A2", Range("B" & Rows.Count).End(xlUp))
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(Ary)
         If Not .exists(Ary(i, 1)) Then
            .Add Ary(i, 1), Ary(i, 2)
            Ary(i, 1) = ""
         Else
            .Item(Ary(i, 1)) = .Item(Ary(i, 1)) & "; " & Ary(i, 2)
         End If
      Next i
      i = 0
      ReDim Nary(1 To .Count, 1 To 2)
      For Each Ky In .keys
         i = i + 1
         Nary(i, 1) = Ky
         Nary(i, 2) = .Item(Ky)
      Next Ky
   End With
   Range("A2", Range("B" & Rows.Count).End(xlUp)).ClearContents
   Range("A2").Resize(i, 2).Value = Nary
End Sub

 

[Punquey]

Yes much quicker.