VBA?

Sub Test()
Dim iLastRow As Long
Dim i As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
Cells(i, "B").Resize(, 253).Copy Cells(i - 1, "C")
Rows(i).Delete
End If
Next i

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Geno" wrote in message
ups.com...
I have a spreadsheet that has a list of companies and contacts within
those companies. Some rows have one company with one contact for that
company. Many rows have the same company info duplicated with a
different contact info for that company. What I need is unique rows
with unique company name and all the contacts for that company in the
same row.