Sub Macro1()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
s2.Range("A:A").NumberFormat = "@"


s1.Activate
Columns("A:B").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers

ior = 0
ioc = 1
Set r = s2.Range("A2")
n = Cells(Rows.Count, 1).End(xlUp).Row
r.Value = Range("B2").Value
p_old = r.Value
r.Offset(0, 1).Value = Range("A2").Value

For i = 3 To n
d = Cells(i, "A").Value
pn = Cells(i, "B").Value
If pn = p_old Then
ioc = ioc + 1
r.Offset(ior, ioc).Value = d
Else
ioc = 1
ior = ior + 1
r.Offset(ior, 0).Value = pn
r.Offset(ior, ioc).Value = d
p_old = pn
End If
Next
End Sub

the routine first sorts the source data.
--
Gary''s Student - gsnu200747


"Mim" wrote:

I need to compare a list of part numbers in Col. B from Sheet 1. When a
duplicate if sound, I need to copy the Part Number and corresponding Dates
(from Col. A) to Sheet 2 to read across in a row, such that the part number
shows up once, with all dates reading across the same row in subsequent
columns.
After comparing the first part number in the list, I have to compare the
next to the list, and the next and the next...

Example:

Sheet1: Col. A Col. B.
Date Part #
1/1/07 01234.0
1/3/07 04587.0
1/12/07 03874.0
1/24/07 01234.0
2/15/07 01234.0
2/18/07 04587.0
3/13/07 01234.0

Sheet 2: Col. A Col. B Col. C Col. D Col. E....
Part # 1st Date 2nd Date 3rd Date 4th Date
01234.0 1/1/07 1/24/07 2/15/07 3/13/07
04587.0 1/3/07 2/18/07

And so on down the list.
I'm having a problem getting the Dates into the "Next Empty Cell" on the
correct line. I'm also having a problem when I come to a part number that I
have already seen previously in the list.
Help, please.