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.

Name	Attributes
Tom	Male, Teen, Tall, Glasses, Black hair
Henry	Male, Adult, Short
Clarissa	Female, Adult
Sam	Male, Child, Short, Black hair
Sarah	Female, Teen, Red hair

<tbody>
</tbody>

I require it to look something like this.

Name	Attributes
Tom	Male
Tom	Teen
Tom	Tall
Tom	Glasses
Tom	Black hair
Henry	Male
Henry	Adult
Henry	Short
Clarissa	Female
Clarissa	Adult
Sam	Male
Sam	Child
Sam	Short
Sam	Black hair
Sarah	Female
Sarah	Teen
Sarah	Red hair

<tbody>
</tbody>

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...