Text to column but in rows

[Gehree]

Hi All,

First time on this forum and was hoping to get some help. I am trying to do a text to column but in vertical format instead of having it split horizontally.

For example,
My data now looks something like this.
[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Attributes[/TD]
[/TR]
[TR]
[TD]Tom[/TD]
[TD]Male, Teen, Tall, Glasses, Black hair[/TD]
[/TR]
[TR]
[TD]Henry[/TD]
[TD]Male, Adult, Short[/TD]
[/TR]
[TR]
[TD]Clarissa[/TD]
[TD]Female, Adult[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD]Male, Child, Short, Black hair[/TD]
[/TR]
[TR]
[TD]Sarah[/TD]
[TD]Female, Teen, Red hair[/TD]
[/TR]
</tbody>[/TABLE]

I require it to look something like this.
[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Attributes[/TD]
[/TR]
[TR]
[TD]Tom[/TD]
[TD]Male[/TD]
[/TR]
[TR]
[TD]Tom
[/TD]
[TD]Teen[/TD]
[/TR]
[TR]
[TD]Tom[/TD]
[TD]Tall[/TD]
[/TR]
[TR]
[TD]Tom[/TD]
[TD]Glasses[/TD]
[/TR]
[TR]
[TD]Tom[/TD]
[TD]Black hair[/TD]
[/TR]
[TR]
[TD]Henry[/TD]
[TD]Male[/TD]
[/TR]
[TR]
[TD]Henry[/TD]
[TD]Adult[/TD]
[/TR]
[TR]
[TD]Henry[/TD]
[TD]Short[/TD]
[/TR]
[TR]
[TD]Clarissa[/TD]
[TD]Female[/TD]
[/TR]
[TR]
[TD]Clarissa[/TD]
[TD]Adult[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD]Male[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD]Child[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD]Short[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD]Black hair[/TD]
[/TR]
[TR]
[TD]Sarah[/TD]
[TD]Female[/TD]
[/TR]
[TR]
[TD]Sarah[/TD]
[TD]Teen[/TD]
[/TR]
[TR]
[TD]Sarah[/TD]
[TD]Red hair[/TD]
[/TR]
</tbody>[/TABLE]

Any help would be greatly appreciated!

Thank you!

 

[Gehree]

You're very welcome...

Hi Tonyyy,

I just ran the code on a larger sample and noticed something strange, while the code does its function, it leaves a few misaligned gaps in between when there are entries without commas or when there are blanks in between. Here's an example of how it looks.

Before I run the code, it looks like this:
[TABLE="class: grid, width: 200, align: left"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Attributes[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]1, 2, 3[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]4, 5[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]7, 8[/TD]
[/TR]
[TR]
[TD]E[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]F[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]G[/TD]
[TD]10, 11[/TD]
[/TR]
</tbody>[/TABLE]













After I run the code, it looks like this.
[TABLE="class: grid, width: 200, align: left"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Attributes[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]E[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]F[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]G[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]G[/TD]
[TD]11[/TD]
[/TR]
</tbody>[/TABLE]



























Any idea why it's like this?

 

[tonyyy]

Gehree,

Ah, you've got bad data, and will need to clean it up before running the macro.

jk!

In future though, please try to post a representative data sample in your initial post. This will help you get a better solution sooner rather than later.

Sub TextToRows()
Application.ScreenUpdating = False
Dim i As Long
Dim arr As Variant

For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
    arr = Split(Cells(i, 2).Value, ",")
    If UBound(arr) > 0 Then
        Rows(i + 1 & ":" & i + UBound(arr)).Insert
        Cells(i, 1).Resize(UBound(arr) + 1, 1) = Cells(i, 1).Value
        Cells(i, 2).Resize(UBound(arr) + 1, 1) = Application.Transpose(arr)
    End If
Next i
End Sub

The revised code accommodates single and blank entries.

Cheers,

tonyyy

 

[Gehree]

Gehree,

Ah, you've got bad data, and will need to clean it up before running the macro.

jk!

In future though, please try to post a representative data sample in your initial post. This will help you get a better solution sooner rather than later.

Sub TextToRows()
Application.ScreenUpdating = False
Dim i As Long
Dim arr As Variant

For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
    arr = Split(Cells(i, 2).Value, ",")
    If UBound(arr) > 0 Then
        Rows(i + 1 & ":" & i + UBound(arr)).Insert
        Cells(i, 1).Resize(UBound(arr) + 1, 1) = Cells(i, 1).Value
        Cells(i, 2).Resize(UBound(arr) + 1, 1) = Application.Transpose(arr)
    End If
Next i
End Sub

The revised code accommodates single and blank entries.

Cheers,

tonyyy

Hi Tonyyy,

Hahah yes, in fact you are right, I do have bad data and I'm in the midst of cleaning it but I got 7000 entries with 50 columns of attributes to work with so it's taking me a long time to do it. In any case, it's working perfectly now. You have no idea how much time you just saved for me!

Thank you so much!(Again)

Cheers,
Gehree

 

[tonyyy]

You're very welcome, Gehree...