Rows to column

[Sjakkie]

I have a team listing in rows where it it says
1 2 3
a user1 Lead 1 Date1
b user2 Lead 1 Date1
c user3 Lead 2 Date1
d user4 Lead 3 Date1
e user5 Lead 2 Date1
f user6 Lead 1 Date1

How Can i change this so that it goes to

1 2 3
a Lead1 Lead2 Lead3
b user1 user3 User4
c user2 user5
d user6
e
f

The list continues on and on.

 

[Bob Phillips]

Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long
Dim iCol As Long
Dim iRow As Long

With ActiveSheet
Worksheets.Add.Name = "__new"
iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 1 To iLastRow
iCol = 0
On Error Resume Next
iCol = Application.Match(.Cells(i, "B").Value, _
Worksheets("__new").Rows(1), 0)
On Error GoTo 0
If iCol = 0 Then
iCol = Worksheets("__new").Range("A1").End(xlToRight).Column
+ 1
If iCol > .Columns.Count Then
iCol = IIf(Worksheets("__new").Range("A1").Value = "",
1, 2)
End If
Worksheets("__new").Cells(1, iCol).Value = .Cells(i,
"B").Value
iRow = 2
Else
iRow = Worksheets("__new").Cells(1, iCol).End(xlDown).Row +
1
End If
Worksheets("__new").Cells(iRow, iCol).Value = .Cells(i,
"A").Value
Next i
End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)