How do you transpose X number of sequential rows into their own separate columns?

[msisepleld]

Hello everyone!
I am new to VBA macro coding and could use a little assistance.


Issue: My current file has all data in one column "A". How do you transpose X number of sequential rows into their own separate columns?
Possible Solution for what I want: A VBA macro that solves the issue.

My Layman's Explanation:

** My data came in one large column ("A") and this consists of the "Name", "Abbreviation of Name", "Phone Number".

Example: My current data looks like this.

	A
1	John Smith
2	JS
3	(202) 456-1111
4	Tom Cruse
5	TC
6	(213) 580-7500
7	Danny Ocean
8	DO
9	(702) 693-7111

<tbody>
</tbody>

** I would like to transpose the data as such.

Example:

	A	B	C
1	John Smith	JS	(202) 456-1111
2	Tom Cruse	TC	(213) 580-7500
3	Danny Ocean	DO	(702) 693-7111

<tbody>
</tbody>

Breakdown on how I think the macro would work:

1.) Start on cell "A1" using Explicit Range Formula.
2.) Move to Implicit Next Cell. Ex: "A2"
3.) Copy Cell to Transposed Position. Ex: "B1"
4.) Delete Implicit Row below Starting Row. Ex: Row "2"
5.) Copy new datum in Cell after deletion of Row. Ex: "A2"
6.) Paste Cell to transposed position + 1 column. Ex: "C1"
7.) Delete Implicit Row. Ex: Row "2"
8.) Repeat from "Step 2" with new Implicit Cell. Ex: "A3"
9.) Stop when Explicit Range is completed. Ex: "A1:A1000"

So I believe this would use a combination of a VBA Deletion and VBA Transpose code such as the codes I posted below.

Deletion Code Example:

Sub Delete_Rows()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("A1:C20"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "XXXXXXXX" _
Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub

Transpose Code Example:

ActiveChart.PlotBy = xlColumns
ActiveChart.PlotBy = xlRows 
    '(I AM NOT USEING A CHART SO IT WONT BE THIS.)

Thank you all for your assistance!
I hope this post uses good keywords to help people who look for this solution in the future.

James E.

 

[apo]

Hi..

Looks very much like the requirements in this post from only a few hours ago...

http://www.mrexcel.com/forum/excel-questions/718378-transpose-data-rows-columns.html

 

[msisepleld]

Wow. You are correct, We DID ask the same question just a few hours apart. Sorry about that. Anyways Thank you Rick!

This macro should work just about as fast as is possible to process all that data...

Sub TransposeData()
  Dim X As Long, LastRow As Long, DataIn As Variant, DataOut As Variant
  Const StartRow As Long = 1
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  DataIn = Cells(StartRow, "A").Resize(LastRow - StartRow + 1)
  ReDim DataOut(1 To UBound(DataIn) \ 3, 1 To 3)
  For X = StartRow To LastRow Step 3
    DataOut(1 + X \ 3, 1) = DataIn(X, 1)
    DataOut(1 + X \ 3, 2) = DataIn(X + 1, 1)
    DataOut(1 + X \ 3, 3) = DataIn(X + 2, 1)
  Next
  Columns("A").Clear
  Cells(StartRow, "A").Resize(UBound(DataIn) \ 3, 3) = DataOut
End Sub

The only thing you might have to change is the value assigned to the StartRow constant (the Const statement)... that needs to be the row number for your first piece of data.

This 100% worked. Please close + add SOLVED: to this thread if possible.

 

[msisepleld]

ACTUALLY Now I keep getting an error..... The macro worked the first time HOWEVER I noticed an extra line in my original data which caused the macro to put informaion in the wrong columns. I fixed it and when I try to run the macro now I get the error:

"Run-time error '9': Subscript out of range
or
"Run-time error '13': Mismatch data?

 

[markmzz]

Another way (without VBA):

Layout:

John Smith	John Smith	JS	(202) 456-1111
JS	Tom Cruse	TC	(213) 580-7500
(202) 456-1111	Danny Ocean	DO	(702) 693-7111
Tom Cruse
TC
(213) 580-7500
Danny Ocean
DO
(702) 693-7111
**************	**************	*************	**************

<tbody>
</tbody>

Formula:

B1-> =IFERROR(INDEX($A$1:$A$9,(ROWS($B$1:B1)-1)*ROWS($A$1:$A$3)+COLUMNS($B$1:B1)),"")

Markmzz

 

[Rick Rothstein]

ACTUALLY Now I keep getting an error..... The macro worked the first time HOWEVER I noticed an extra line in my original data which caused the macro to put informaion in the wrong columns. I fixed it and when I try to run the macro now I get the error:

"Run-time error '9': Subscript out of range
or
"Run-time error '13': Mismatch data?

You cannot use the code I posted a second time on already processed values... you would need to reload the original data, remove the extra line and then run my code against that.

 

[msisepleld]

I figured out why I was receiving the error 9.

Using Rick's Code. If you do not have an equal number of data relative to the number of columns then it will spit back "error 9".

This means. For Rick's code. Unless the TOTAL amount of data my list ends with a multiple of 3, I will get that error. In my original data spreadsheet where all data was in row "A" i had 1303 rows of data points. Somewhere in my list I found that extra line. I deleted it, and once there were only 1302 lines of data, (1302/3 = 434) the macro worked.

 

[Rick Rothstein]

I figured out why I was receiving the error 9.

Using Rick's Code. If you do not have an equal number of data relative to the number of columns then it will spit back "error 9".

This means. For Rick's code. Unless the TOTAL amount of data my list ends with a multiple of 3, I will get that error.

I wrote my code that way because your opening message said this

My data came in one large column ("A") and this consists of the "Name", "Abbreviation of Name", "Phone Number"

which indicated to me that the number of rows of data woul always be an even multiple of three.