dim MyRow as long, i as long
dim MyStr as string
for myrow = 2 to cells(rows.count,1).end(xlup).row
if cells(myrow,1)= cells(myrow+1,1) then
mystr = mystr & "," & cells(myrow,3)
else
i = i +1
cells(i,6)=cells(myrow,1)
cells(i,7)= mid(mystr & "," & cells(myrow,3),2,9999)
mystr = ""
end if
next