On Sep 20, 12:11 am, Dolphy wrote:
On Sep 20, 2:00 pm, Dolphy wrote:



On Sep 20, 1:42 pm, JW wrote:

On Sep 19, 10:35 pm, Dolphy wrote:

Hi All,

Is there a way to have data transploted from a Vertical to
horizointal?

I've looked a Paste Spoecial command but I have over 20K of rows to
sort;

Sample Data:

04xxxxxxxx Smog
04xxxxxxxx alto
04xxxxxxxx wagon
04xxxxxxxx carriage
04xxxxxxxx beeer
04xxxxxxxx wine
04xxxxxxxx cola
04xxxxxxxx bourbon
04yyyyyyyy Smog
04yyyyyyyy alto
04yyyyyyyy wagon
04yyyyyyyy carriage
04yyyyyyyy beeer
04yyyyyyyy wine
04yyyyyyyy bourbon
04zzzzzzzz Smog
04zzzzzzzz alto
04zzzzzzzz wagon
04zzzzzzzz carriage
04zzzzzzzz beeer
04zzzzzzzz wine
04zzzzzzzz bourbon
04zzzzzzzz magic
04zzzzzzzz zulu
04zzzzzzzz tango

And I want to output the data as:

04xxxxxxxx Smog alto wagon carriage beeer wine cola bourbon
04yyyyyyyy Smog alto wagon carriage beeer wine bourbon
04zzzzzzzz Smog alto wagon carriage beeer wine bourbon magic zulu
tango

Is there a macro or formula that can be used?

Rgds,
Dolphy

Quick and dirty. This is only going based off of your example data
where you want to consolidate column B value into one row if they
match on column A. Be sure to run this on a copy of your data to be
sure that you get the desired results.
Sub consil()
Dim r As Long, bRow As Long
bRow = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To bRow
If IsEmpty(Cells(r, 1)) Then Exit For
If Cells(r, 1).Text = Cells(r, 1).Offset(1, 0).Text Then
Cells(r, Range("IV" & r).End(xlToLeft).Offset(0,
1).Column) = _
Cells(r, 1).Offset(1, 1).Text
Cells(r, 1).Offset(1, 1).EntireRow.Delete
r = r - 1: bRow = bRow - 1
End If
Next
End Sub

Thanks for the quick reply.

When I run the script I get a syntax error.

Can you have a quick look at this?

Rgds,
Dolphy

I screwed up and I left out two columns:
\
04xxxxxxxx apple HOME Smog
04xxxxxxxx apple HOME alto
04xxxxxxxx apple HOME wagon
04xxxxxxxx apple HOME carriage
04xxxxxxxx apple HOME beeer
04xxxxxxxx apple HOME wine
04xxxxxxxx apple HOME cola
04xxxxxxxx apple HOME bourbon
04yyyyyyyy orange WORK Smog
04yyyyyyyy orange WORK alto
04yyyyyyyy orange WORK wagon
04yyyyyyyy orange WORK carriage
04yyyyyyyy orange WORK beeer
04yyyyyyyy orange WORK wine
04yyyyyyyy orange WORK bourbon
04zzzzzzzz banana OFFICE Smog
04zzzzzzzz banana OFFICE alto
04zzzzzzzz banana OFFICE wagon
04zzzzzzzz banana OFFICE carriage
04zzzzzzzz banana OFFICE beeer
04zzzzzzzz banana OFFICE wine
04zzzzzzzz banana OFFICE bourbon
04zzzzzzzz banana OFFICE magic
04zzzzzzzz banana OFFICE zulu
04zzzzzzzz banana OFFICE tango

Output should look like:

04xxxxxxxx apple HOME Smog alto wagon carriage beeer wine cola
bourbon
04yyyyyyyy orange WORK Smog alto wagon carriage beeer wine
bourbon
04zzzzzzzz banana OFFICE Smog alto wagon carriage beeer
wine bourbon magic zulu tango

Thanks!

Dolphy

Ah, didn't see this post before I posted the other one. In that case,
simply change the offset:
Sub consil()
Dim r As Long, bRow As Long
bRow = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To bRow
If IsEmpty(Cells(r, 1)) Then Exit For
If Cells(r, 1).Text = Cells(r, 1).Offset(1, 0).Text Then
Cells(r, Range("IV" & r).End(xlToLeft).Offset(0,
1).Column) = _
Cells(r, 1).Offset(1, 3).Text
Cells(r, 1).Offset(1, 1).EntireRow.Delete
r = r - 1: bRow = bRow - 1
End If
Next
End Sub