Split out data from a cell to new rows.

[jon110763]

Hi, I have a spreadsheet that has multiple rows and in 1 column there is multiple numbers separated by a comma, in the row. I need the numbers to be separated into new rows, keeping the integrity of the original rows.
The total rows vary from day to day and the amount of numbers in col D varies with each row.
How someone can help me.
Ask for any more info as necessary
Thanks
Jon

Original spreadsheet.

London	123456	Apple	123456,123457,123458,123459
Dallas	654321	Orange	123460,123461
Paris	162534	Black	123465,123467,123469
Desired result
London	123456	Apple	123456
			123457
			123458
			123459
Dallas	654321	Orange	123460
			123461
Paris	162534	Black	123465
			123467
			123469

 

[kweaver]

Making sure that column D is text, try this:

Sub SplitInsert()
    Dim r As Range
    Dim a As Variant
    Sheets("Sheet1").Range("D:D").NumberFormat = "@"
    For Each r In Range("D:D")
        If r.Value Like "*,*" Then
            Debug.Print True
            a = Split(r.Value, ",")
            r.Offset(1, 0).Resize(UBound(a)).EntireRow.Insert Shift:=xlDown
            For i = LBound(a) To UBound(a)
                r.Offset(i, 0).Value = a(i)
            Next i
        End If
    Next r
End Sub