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!

 

[tonyyy]

Gehree,

Welcome to the Board.

If you're comfortable with a vba approach, you might consider the following...

Sub TextToRows()
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, ",")
    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)
Next i
End Sub

Cheers,

tonyyy

 

[Gehree]

Gehree,

Welcome to the Board.

If you're comfortable with a vba approach, you might consider the following...

Sub TextToRows()
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, ",")
    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)
Next i
End Sub

Cheers,

tonyyy

Hi Tony,

I'm not too familiar with VBA but when I copied this into the macro box and tried to run it, It says there's a run time error '1004'.

I can't recognize the scripting that you did so I don't know what went wrong. Is there any additional steps that I have to take?

Thank you!

Regards,
Gehree

 

[MARK858]

The code from tonyyy ran fine for me, do you have any protection on the sheet and is your data in columns A & B?

Also is the sheet you want the macro on the activesheet? and also describe in more detail what you done to run the code.

 

[Gehree]

The code from tonyyy ran fine for me, do you have any protection on the sheet and is your data in columns A & B?

Also is the sheet you want the macro on the activesheet? and also describe in more detail what you done to run the code.

Hi Mark,

I don't have any protection and yes my data is in columns A and B.

I basically copied the whole text, went under "Developer" tab, selected "Visual Basic" icon and pasted the coding into the empty space. I then closed it and clicked on "Macros" icon and clicked "Run".

The 7th line in his code, "Cells(i, 1).Resize(UBound(arr) + 1, 1) = Cells(i, 1).Value" has been highlighted yellow, I assume that means the issue lies in this line for me?

Sorry, I'm very bad at this.

Regards,
Gehree

 

[MARK858]

What happens if you download and open the file in the link below, enable macros and click the button?

https://app.box.com/s/pl773m88nemdrtte48hukkjo6jfdihh3

 

[Gehree]

What happens if you download and open the file in the link below, enable macros and click the button?

https://app.box.com/s/pl773m88nemdrtte48hukkjo6jfdihh3

Oh this worked! Could it be because my actual set of data has blanks in between? Would volume of data affect it too?

 

[tonyyy]

Thanks, Mark858, for stepping in.

Gehree - The error could be generated if there's an empty cell in Column B. (An empty cell would not create an array, and therefore Ubound(arr) would fail.) You might try the following modification to skip past empty cells.

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
    If Cells(i, 2) <> "" Then
        arr = Split(Cells(i, 2).Value, ",")
        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

 

[Gehree]

Thanks, Mark858, for stepping in.

Gehree - The error could be generated if there's an empty cell in Column B. (An empty cell would not create an array, and therefore Ubound(arr) would fail.) You might try the following modification to skip past empty cells.

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
    If Cells(i, 2) <> "" Then
        arr = Split(Cells(i, 2).Value, ",")
        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

Hi Tony/Mark,

Yes this time it worked!

Thank you so much for both your help!

Regards,
Gehree

 

[tonyyy]

You're very welcome...