Transpose Columns to Rows by blank

[snehaa]

<style type="text/css"> p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica} p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Helvetica; min-height: 14.0px} span.Apple-tab-span {white-spacere} </style>I need to transpose vertical data from column B to horizontal data.

My table looks like this:


<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 10.0px Arial}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; text-align: right; font: 10.0px Arial}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; text-align: right; font: 10.0px Arial; min-height: 11.0px}table.t1 {border-collapse: collapse}td.td1 {border-style: solid; border-width: 1.0px 1.0px 1.0px 1.0px; border-color: #cbcbcb #cbcbcb #cbcbcb #cbcbcb; padding: 0.0px 5.0px 0.0px 5.0px}</style>

Andrea Anderson	85.98
	97.62
	100.00
	100.00
Jane Austin	89.81
	78.70
	100.00
Jack Willow	94.32
Anna Kendrick
Frida Kahlo	90.91
	0.00
	88.54
	76.96
	94.32
	89.11

<tbody>
</tbody>

And I want it to look like this:


<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 10.0px Arial}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; text-align: right; font: 10.0px Arial}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; text-align: right; font: 10.0px Arial; min-height: 11.0px}table.t1 {border-collapse: collapse}td.td1 {border-style: solid; border-width: 0.8px 0.8px 0.8px 0.8px; border-color: #000000 #000000 #000000 #000000; padding: 0.0px 5.0px 0.0px 5.0px}</style>

Andrea Anderson	85.98	97.62	100.00	100.00
Jane Austin	89.81	78.70	100.00
Jack Willow	94.32
Anna Kendrick
Frida Kahlo	90.91	0.00	88.54	76.96	94.32	89.11

<tbody>
</tbody>

I am using the following code:

> Sub Transpose()
>     Dim t As Range, u As Range
>     c = ActiveCell.Column
>     fr = ActiveCell.Row
>     lr = Cells(Rows.Count, c).End(xlUp).Row
>     r = fr
>     Do
>         Set t = Cells(r, c)
>         Set u = t.End(xlDown)
>         Range(t, u).Copy
>         t.Offset(, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
>         r = u.End(xlDown).Row
>     Loop While r < lr
>    Application.CutCopyMode = False End Sub

The problem is .End(x1Down) doesn't work because there are single rows of data. Is there a solution for this?

 

[Special-K99]

Re: Transpose Columns to Rows by blank help!!

Use

lastrow = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row

You're looking at the column of values to determine the row containing the last value.

 

[snehaa]

Re: Transpose Columns to Rows by blank help!!

Thank you but that still doesn't resolve the single row issue. It transposes well until it hits the value in just a single row because the .End(x1Down) only reads values in 2 or more consecutive rows.

Use

lastrow = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row

You're looking at the column of values to determine the row containing the last value.

 

[Special-K99]

Re: Transpose Columns to Rows by blank help!!

There's nothing wrong with this at all.
You have 19 rows in column B.
This

lastrow = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row

returns 19.
So now you know how many rows are in your table.

You will of course have to manipulate the value in column A by retaining the LAST column A value so when you come across a blank in column A you just you use the previous value which is the value you've retained. Similarly you need to check when both A and B are blank.

QUESTION: Is there any reason why you are retaining numeroues blank rows between the names? They are not consistent with each name change. They seem to reflect the number of values in column B that were in the original table.

 

[Special-K99]

Re: Transpose Columns to Rows by blank help!!

This works but does not produce any blank rows between names
Input on Sheet1
Output on Sheet2

Sub k1()
lasta = ""
lastrow = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To lastrow
If Worksheets("Sheet1").Cells(i, 1) <> lasta Then
j = j + 1
Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1)
Worksheets("Sheet2").Cells(j, 2) = Worksheets("Sheet1").Cells(i, 2)
k = 2
Else
k = k + 1
Worksheets("Sheet2").Cells(j, k) = Worksheets("Sheet1").Cells(i, 2)
End If
Next i
End Sub

It also uses the "lastrow" line I exactly as I posted earlier.

This modification adds the blank lines exactly as you've specified.

Sub k1()
lasta = ""
lastrow = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
k = 2
For i = 1 To lastrow
If Worksheets("Sheet1").Cells(i, 1) <> lasta Then
j = j + k - 1
Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1)
Worksheets("Sheet2").Cells(j, 2) = Worksheets("Sheet1").Cells(i, 2)
k = 2
Else
k = k + 1
Worksheets("Sheet2").Cells(j, k) = Worksheets("Sheet1").Cells(i, 2)
End If
Next i
End Sub

 

[snehaa]

Re: Transpose Columns to Rows by blank help!!

=Special-K99;4871146]There's nothing wrong with this at all.
You have 19 rows in column B.
This

lastrow = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row

returns 19.
So now you know how many rows are in your table.

You will of course have to manipulate the value in column A by retaining the LAST column A value so when you come across a blank in column A you just you use the previous value which is the value you've retained. Similarly you need to check when both A and B are blank.

QUESTION: Is there any reason why you are retaining numeroues blank rows between the names? They are not consistent with each name change. They seem to reflect the number of values in column B that were in the original table.

The code returns the following table. It is not transposing correctly when it gets to Jack Willow. Also I am keeping the spaces because there are names such as Anna Kendrick that have no values, but I want to retain them in the list. This data sheet has over 1000 entries, and there are many names that have no values.

Andrea Anderson	85.98	97.62	100.00	100.00
Jane Austin	89.81	78.70	100.00
Jack Willow	94.32				90.91
Anna Kendrick
Frida Kahlo	89.11

<tbody>
</tbody>

 

[snehaa]

Re: Transpose Columns to Rows by blank help!!

This code doesn't seem to give me any output

This works but does not produce any blank rows between names
Input on Sheet1
Output on Sheet2

Sub k1()
lasta = ""
lastrow = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To lastrow
If Worksheets("Sheet1").Cells(i, 1) <> lasta Then
j = j + 1
Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1)
Worksheets("Sheet2").Cells(j, 2) = Worksheets("Sheet1").Cells(i, 2)
k = 2
Else
k = k + 1
Worksheets("Sheet2").Cells(j, k) = Worksheets("Sheet1").Cells(i, 2)
End If
Next i
End Sub

It also uses the "lastrow" line I exactly as I posted earlier.

This modification adds the blank lines exactly as you've specified.

Sub k1()
lasta = ""
lastrow = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
k = 2
For i = 1 To lastrow
If Worksheets("Sheet1").Cells(i, 1) <> lasta Then
j = j + k - 1
Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1)
Worksheets("Sheet2").Cells(j, 2) = Worksheets("Sheet1").Cells(i, 2)
k = 2
Else
k = k + 1
Worksheets("Sheet2").Cells(j, k) = Worksheets("Sheet1").Cells(i, 2)
End If
Next i
End Sub

 

[snehaa]

Re: Transpose Columns to Rows by blank help!!

Sorry it does work, I had to select the data first. Thank you!!

 

[Mike Szczesny]

I was wondering if you could just use the transpose formula. Then you can take care of inserting rows.

 

[snehaa]

What formula do you propose?

I was wondering if you could just use the transpose formula. Then you can take care of inserting rows.