Transpose the data from X Range.

[Ashrafe07]

Dear Team,

I'm trying to transpose 5 cells horizontally into 5 cells Vertically , then do the next 5 verticals
under the 5 horizontals.

The vertical create data need to paste in a separate sheet

Please see data given below.

Original Data :-
Column 1 Column 2 Column 3 Column 4 Column 5


A
B
C
D
E


F
G
H
I
J


K
L
M
N
O


P
Q
R
S
T


U
V
W
X
Y



Desire Result :-
Column 1


A


B


C


D


E


F


G


…..


Y



VBA code would be most useful, and original data could potentially be 600 cells long.

Any and all help is greatly appreciated.

[ashleyuk1984]

One idea.


Sub Transpose()
Dim LastRow As Integer
Dim x As Integer

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For x = 1 To LastRow
Range("A" & x & ":E" & x).Copy
Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll, , , True
Next

End Sub

[Ashrafe07]

The Following code is taking a longer to execute on large data set i am having 25000 records. Please help how to optimize the code so it take a lesser time to execute.


One idea.


Sub Transpose()
Dim LastRow As Integer
Dim x As Integer

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For x = 1 To LastRow
Range("A" & x & ":E" & x).Copy
Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll, , , True
Next

End Sub

[ashleyuk1984]

Another way would be to use arrays.
But unfortunately I don't know enough about them in order to help you with that. That would most likely be the quickest.

Regarding further edits to my code, you could add a couple of lines to disable the 'screen flickering' that your probably seeing.
This can sometimes reduce the time to nearly half. Especially when dealing with the amount of information that you need to.

New lines added below.


Sub Transpose()
Dim LastRow As Integer
Dim x As Integer

Application.Screenupdating = False

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For x = 1 To LastRow
Range("A" & x & ":E" & x).Copy
Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll, , , True
Next

Application.Screenupdating = True

End Sub

[Ashrafe07]

Can any one help with the array code to reduce the time to execute the data as per the trail thread.


Another way would be to use arrays.
But unfortunately I don't know enough about them in order to help you with that. That would most likely be the quickest.

Regarding further edits to my code, you could add a couple of lines to disable the 'screen flickering' that your probably seeing.
This can sometimes reduce the time to nearly half. Especially when dealing with the amount of information that you need to.

New lines added below.


Sub Transpose()
Dim LastRow As Integer
Dim x As Integer

Application.Screenupdating = False

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For x = 1 To LastRow
Range("A" & x & ":E" & x).Copy
Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll, , , True
Next

Application.Screenupdating = True

End Sub

[Ashrafe07]

Dear ashleyuk1984

Thanks for the support , i just need one help can it be possible to give the msg box after the process is completed to know that the activity is done. As far as time is concerned for 25000 records it is taking 300 seconds i am ok with it.


Can any one help with the array code to reduce the time to execute the data as per the trail thread.

[ashleyuk1984]

Adding a message box is one of the first things you learn when learning vba.
I would really suggest that you start learning it as it can turn jobs that manually take 30 mins into jobs that take 30 seconds or even less!

In order to achieve your message box question, you will need to add one line of code before 'End Sub'.
That's it.

I'm sure you can figure that out. Just Google it. :yes

[GTO]

Dear Team,

I'm trying to transpose 5 cells horizontally into 5 cells Vertically , then do the next 5 verticals
under the 5 horizontals.

The vertical create data need to paste in a separate sheet
...
VBA code would be most useful, and original data could potentially be 600 cells long...


The Following code is taking a longer to execute on large data set i am having 25000 records. Please help how to optimize the code so it take a lesser time to execute.

Greetings ashrafe07,

Welcome to vbax :-) as I see you joined this month. Might I mention that it is helpful to the 'helper' (anyone typing up an example solution) if you include an accurate "picture" of what is being done from the start. In this instance for example, if the range being worked on was as short as first stated, then maybe copy/paste would be plenty quick enough.

Anyways, here would be a simple example of how to take only the values and using arrays, more quickly process the wanted output.

In a Standard Module:


Option Explicit

Sub ExampleTranspose()
Dim LastRow As Long
Dim n As Long
Dim x As Long
Dim y As Long
Dim arrIn As Variant
Dim arrOut As Variant

With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
arrIn = .Range(.Cells(1, 1), .Cells(LastRow, 5)).Value
End With

ReDim arrOut(1 To (LastRow * 5), 1 To 1)

For y = 1 To UBound(arrIn, 1)
For x = 1 To 5
n = n + 1
arrOut(n, 1) = arrIn(y, x)
Next
Next

ThisWorkbook.Worksheets("Sheet2").Range("A1").Resize(UBound(arrOut, 1)).Value = arrOut

End Sub

Hope that helps,

Mark

[Ashrafe07]

Dear vbax :-

It is working can you help me i am having 20 horizontal column which need to be converted to 20 vertical row and the horizontal data start from column D. Please help.


Greetings ashrafe07,

Welcome to vbax :-) as I see you joined this month. Might I mention that it is helpful to the 'helper' (anyone typing up an example solution) if you include an accurate "picture" of what is being done from the start. In this instance for example, if the range being worked on was as short as first stated, then maybe copy/paste would be plenty quick enough.

Anyways, here would be a simple example of how to take only the values and using arrays, more quickly process the wanted output.

In a Standard Module:


Option Explicit

Sub ExampleTranspose()
Dim LastRow As Long
Dim n As Long
Dim x As Long
Dim y As Long
Dim arrIn As Variant
Dim arrOut As Variant

With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
arrIn = .Range(.Cells(1, 1), .Cells(LastRow, 5)).Value
End With

ReDim arrOut(1 To (LastRow * 5), 1 To 1)

For y = 1 To UBound(arrIn, 1)
For x = 1 To 5
n = n + 1
arrOut(n, 1) = arrIn(y, x)
Next
Next

ThisWorkbook.Worksheets("Sheet2").Range("A1").Resize(UBound(arrOut, 1)).Value = arrOut

End Sub

Hope that helps,

Mark

[GTO]

Hi there,

My name is Mark; vbax is short for VBA Express, the name of this site.

What code have you tried writing thus far?

Mark

[Ashrafe07]

Hi Mark,

I test your code and it is working fine. I need one help that the data should read from column 4 and then given the desire output to vertical in sheet 2. Please help.


Hi there,

My name is Mark; vbax is short for VBA Express, the name of this site.

What code have you tried writing thus far?

Mark

[apo]

Hi..

I tried adding each 'row' of data to a single element of an array and then split that element into a 1 dimensional array with many elements and then transpose to the sheet..

Worth a try ay..?

Works well on small set of data.. seems to take too long on large sets I think though..

Any experts have any advice why?



Private Sub CommandButton1_Click()
Dim x, xx, i As Long
With Range("A1").CurrentRegion
x = .Value
For i = LBound(x) To UBound(x)
xx = xx & " " & Join(Application.Index(x, i, 0))
Next i
Range("F1").Resize(.SpecialCells(12).Count).Value = Application.Transpose(Split(Trim(xx), " "))
End With
End Sub