VBA code for transposing

[nedy_03]

Hello,

Long time no see, but still need u guys. I have this situation:
-> on column A I have a code (ex: 852996) that identifies a firm
-> on column B I have the phone number for avery code

A code may have one or more phone numbers, but they apperas on different rows. By ex:
__A___|_____ B_______|
852996 | 003903548798 |
852996 | 003906897896 |
823698 | 003902569874 |
852996 | 003902698756 |

Can u help me with a vb code that do the following:
- if it finds a code more than once, it takes the corispondig phone number of the 2nd, 3rd etc,. and puts it on the row where the code were found the first time, than delets the row 2,3, ... and so on?

The result should be :
__A___ |_____ B_______ |____ C______ |_____ D______ |
852996 | 0039035487987 | 003906897896 | 003902698756 |
823698 | 003902569874

Thank you ...
Nedy

[Bob Phillips]

[vba]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim LastCol As Long
Dim cell As Range
Dim sh As Worksheet

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

.Columns("A:B").Sort key1:=Range("A1"), order1:=xlDescending, header:=xlNo
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then

LastCol = .Cells(i - 1, .Columns.Count).End(xlToLeft).Column
.Cells(i, "B").Resize(, 256 - LastCol).Copy .Cells(i - 1, "C")
.Rows(i).Delete
End If
Next i

End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub
[/vba]

[nedy_03]

Thx xld ... always on time!