ExcelBanter - Transpose random series of cells

Try the macro

Sub copy()
'This will read Sheet1 and write to Sheet2
'It is assumed that Sheet2 won't have anything from row 2 down
'It will overwrite if there is anything

Dim lastRow1 As Long
Dim i, j, k As Long
Dim id As String

'Find last row of data on Sheet1
With Worksheets("Sheet1")
lastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

id = ""
'Change 1 to 0 below if you want to start at row 1 in Sheet2
j = 1

'Change 1 to 2 below if you have header rows
For i = 1 To lastRow1
If Worksheets("Sheet1").Cells(i, 1) = id Then
'As long as Id does not change write to the same row
Worksheets("Sheet2").Cells(j, k) = Worksheets("Sheet1").Cells(i, 2)
k = k + 1
Else
'start a new row when id changes
k = 3
j = j + 1
id = Worksheets("Sheet1").Cells(i, 1)
Worksheets("Sheet2").Cells(j, 1) = id
Worksheets("Sheet2").Cells(j, 2) = Worksheets("Sheet1").Cells(i, 2)

End If
Next i
MsgBox "Processing Complete"
End Sub

" wrote:

I have a 60,000 long series of items that correspond with a range of
values. I need to automatically transpose the corresponding values
so
that they can be combined into one cell.

Here's what I have:

A B
1.2101R 1992
1.2101R 1993
1.2101R 1994
1.2101R 1995
1.2102G 1986
1.2102G 1987
10.1101G 1963
10.1101G 1964
10.1101G 1965
10.1101G 1966
10.1101G 1967
10.1101G 1968

Here's what I need
1.2101R 1992 1993 1994 1995
1.2102G 1986 1987
10.1101G 1963 1964 1965 1966 1967 1968

As you can see there are different quantities with each item.