I have data (lots of it - 200k lines) that looks like this:

Row/Column A B
1 RABBIT 123
2 RABBIT 887
3 RABBIT 455
4 PIG 336
5 PIG 723

I want this to look like:
Row/Column A B C D
1 RABBIT 123 887 455
2 PIG 336 723


I know that I can transpose each one in turn, but that would take weeks.

Is there someone clever out there ?

Try this macro: assumes data on Sheet1 is rotated on Sheet2

Sub Rotate()

Dim nextrow1 As Long, nextrow2 As Long
Dim lastrow As Long
Dim ws1 As Worksheet, ws2 As Worksheet

nextrow1 = 1
nextrow2 = 1

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")


With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
Do
n = Application.CountIf(.Range("A:A"), .Cells(nextrow1, "A"))
.Cells(nextrow1, "A").Copy ws2.Cells(nextrow2, "A")
.Cells(nextrow1, "B").Resize(n, 1).Copy
ws2.Cells(nextrow2, "B").PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, _ SkipBlanks:= False, Transpose:=True
nextrow1 = nextrow1 + n
nextrow2 = nextrow2 + 1
Loop Until nextrow1 lastrow
End With
End Sub

HTH

"AdrianCoyte" wrote:

I have data (lots of it - 200k lines) that looks like this:

Row/Column A B
1 RABBIT 123
2 RABBIT 887
3 RABBIT 455
4 PIG 336
5 PIG 723

I want this to look like:
Row/Column A B C D
1 RABBIT 123 887 455
2 PIG 336 723


I know that I can transpose each one in turn, but that would take weeks.

Is there someone clever out there ?

Hey Toppers,

I fixed it. Many Many Many thanks.

Genius.


Adrian


"Toppers" wrote:

Try this macro: assumes data on Sheet1 is rotated on Sheet2

Sub Rotate()

Dim nextrow1 As Long, nextrow2 As Long
Dim lastrow As Long
Dim ws1 As Worksheet, ws2 As Worksheet

nextrow1 = 1
nextrow2 = 1

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")


With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
Do
n = Application.CountIf(.Range("A:A"), .Cells(nextrow1, "A"))
.Cells(nextrow1, "A").Copy ws2.Cells(nextrow2, "A")
.Cells(nextrow1, "B").Resize(n, 1).Copy
ws2.Cells(nextrow2, "B").PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, _ SkipBlanks:= False, Transpose:=True
nextrow1 = nextrow1 + n
nextrow2 = nextrow2 + 1
Loop Until nextrow1 lastrow
End With
End Sub

HTH

"AdrianCoyte" wrote:

I have data (lots of it - 200k lines) that looks like this:

Row/Column A B
1 RABBIT 123
2 RABBIT 887
3 RABBIT 455
4 PIG 336
5 PIG 723

I want this to look like:
Row/Column A B C D
1 RABBIT 123 887 455
2 PIG 336 723


I know that I can transpose each one in turn, but that would take weeks.

Is there someone clever out there ?

I suspect problem was the line-wrap when you copied from the NG.

Anway, glad it's solved and working OK.

Thanks for the feedback.

"AdrianCoyte" wrote:

Hey Toppers,

I fixed it. Many Many Many thanks.

Genius.


Adrian


"Toppers" wrote:

Try this macro: assumes data on Sheet1 is rotated on Sheet2

Sub Rotate()

Dim nextrow1 As Long, nextrow2 As Long
Dim lastrow As Long
Dim ws1 As Worksheet, ws2 As Worksheet

nextrow1 = 1
nextrow2 = 1

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")


With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
Do
n = Application.CountIf(.Range("A:A"), .Cells(nextrow1, "A"))
.Cells(nextrow1, "A").Copy ws2.Cells(nextrow2, "A")
.Cells(nextrow1, "B").Resize(n, 1).Copy
ws2.Cells(nextrow2, "B").PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, _ SkipBlanks:= False, Transpose:=True
nextrow1 = nextrow1 + n
nextrow2 = nextrow2 + 1
Loop Until nextrow1 lastrow
End With
End Sub

HTH

"AdrianCoyte" wrote:

I have data (lots of it - 200k lines) that looks like this:

Row/Column A B
1 RABBIT 123
2 RABBIT 887
3 RABBIT 455
4 PIG 336
5 PIG 723

I want this to look like:
Row/Column A B C D
1 RABBIT 123 887 455
2 PIG 336 723


I know that I can transpose each one in turn, but that would take weeks.

Is there someone clever out there ?

Why not just use the Paste Special - transpose function. Select the data to
be transposed and Copy. Select the location to copy to, and select Paste
Special from the Edit menu, then select the Transpose item. This can also be
encoded in VBA using

Selection.Copy
Sheets(DestinationSheet).Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True

if you look close at the data, he wants more than a simple transpose....

"JFK" wrote:

Why not just use the Paste Special - transpose function. Select the data to
be transposed and Copy. Select the location to copy to, and select Paste
Special from the Edit menu, then select the Transpose item. This can also be
encoded in VBA using

Selection.Copy
Sheets(DestinationSheet).Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True

dlw,
you are quite correct. This is more than a transpose issue. I need to do
this more times than a dog scratches an old flea.

I was not able to get Toppers code to compile unfortunately. So the
solution is still evading me.


Thanks,



Adrian

"dlw" wrote:

if you look close at the data, he wants more than a simple transpose....

"JFK" wrote:

Why not just use the Paste Special - transpose function. Select the data to
be transposed and Copy. Select the location to copy to, and select Paste
Special from the Edit menu, then select the Transpose item. This can also be
encoded in VBA using

Selection.Copy
Sheets(DestinationSheet).Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True