Code for copying various cells.

[N1KO]

Hi

I could do with some help, I have a set of values (will be 16
characters long) and they are unique to a certain code (1 code ca
have
multipul values) E.g.

Code Value
111 000752
111 005894
111 007277
111 012297
111 029580
111 033820
111 046019
111 047341
111 071340
111 072354
111 112763
111 180351
113 006661
113 024007
113 030180
113 036242
113 037290
113 037591
113 037648
113 038938
113 061387
113 066591
113 073563

I need to some macro code/formula to copy and paste the value int
another
cell in a list for each Code.

E.g.

Code: 111 in cell A1
List 000752,005894,007277,etc,etc in B1

I need the values to be seperated by a comma and no spaces, they mus
keep the 0's infront of the numbers though.

So basically i need to search the column with the 3digit codes in an
past
the values that are in the cell next to that code into the same cell i
a
list. I need it to do this for every code i have (about 150) with eac
code
being on a seperate line

Need it to look something like below (can't get it spaced properl
though when it posts).

Column A B
Row Code List
1 111 000752,002561,007277,etc,etc
2 113 006661,024007,030180,etc,etc
3
4
5
6


Thanks in Advanc

 

[Dave Peterson]

Maybe...

Option Explicit
Sub testme()

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

With Worksheets("Sheet1")
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
With .Cells(iRow - 1, "B")
.NumberFormat = "@"
.Value = .Text & "," & .Offset(1, 0).Text
End With
.Rows(iRow).Delete
End If
Next iRow
End With
End Sub