Text to Rows

saurabhlotankar · #1 05-27-2015, 03:50 AM

Hi Everyone,

Please find attached excel sheet. In column A there are few values. some of the cells have multiple values. I want to split such values.
But challenge is I dont want to split value and paste in next column(the way we do in Text to Column). I what i want is if there are 3 vales in cell A1(Split by alt+entre) then code should add 2 more rows below that and paste 2 vales in those two rows.

If its confusing, please refer to my sheet. In cell A1, there are 3 values Alex, Smith and peter. What I want is it should i deally add 2 more rows below A1 and pase smith and peter respectively in it.

Thanks

NoSparks · #2 05-27-2015, 05:49 AM

Give this a try

Code:

Sub NamesToRows()
    Dim lr As Long
    Dim i As Long
    Dim arr As Variant
    
With Sheets("Sheet1")
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 1 Step -1
        With Cells(i, 1)
            arr = Split(.Value, Chr(10))
            If UBound(arr) > 0 Then
                .Offset(1, 0).EntireRow.Resize(UBound(arr)).Insert
                .Resize(UBound(arr) + 1) = Application.Transpose(arr)
            End If
        End With
    Next i
End With
End Sub

saurabhlotankar · #3 05-27-2015, 06:09 AM

Its working fine dear. Thanks a lot for this. God bless you.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Delete blank rows between the two rows that contain data	beginner	Excel Programming	5	12-26-2014 12:29 AM
Delete All empty Rows - Print - Undo all Rows deleted	Bathroth	Word VBA	1	10-01-2014 01:40 PM
Grouping table rows to prevent individual rows from breaking across pages	dennist77	Word	1	10-29-2013 11:39 PM
Delete Blank Rows (Cyrillic Text in Spreadsheet )	dozd	Excel	1	02-22-2013 03:24 AM
Count rows and add blank rows accordingly	Hoochtheseal	Word VBA	1	01-29-2013 09:23 PM