Splitting data in a single cell that is seperated by commas, then moving to make individual rows

[lbarky]

Hi
I hope someone can help me.
i'll try and illustrate what I mean, as im fairly new to all of this,
so do not really know the technical 'language' to explain what im
hoping to do.

Column D, in this case being my problem:
Where in each cell there are several pieces of data that are seperated
by commas. I want to be able to split the data at the comma, but
instead of the data continuing across the page(transpose??) so that
each 'piece' of data has its own cell going across in a row, I want
each piece of data to form a new row under the original, and also copy
what was originally in cells A - C

Sheet currently looks like this..........

A B C D

1) JANE 1 YES 123, 45, 789
2) PAUL 2 YES 101, 11
3) CHRIS 3 NO 124, 9999,
5697, 88, 587


so ideally the sheet would end up looking like this.........

A B C D

1) JANE 1 YES 123
2) JANE 1 YES 45
3) JANE 1 YES 789
4) PAUL 2 YES 101
5) PAUL 2 YES 11
6) CHRIS 3 NO 124
7) CHRIS 3 NO 9999

and so on......

Can this be done? if so any help or advice will be greatly appreciated
The sheet I have to work this on is huge

thanks in advance!

 

[Toppers]

Hi,

Try this. Data is copied from Sheet1 to Sheet2. Copy code into a general
module.

Sub transform()

Dim v As Variant
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, r As Long
Dim i As Integer

Set ws1 = Worksheets("sheet1") ' <=== change sheet names as required
Set ws2 = Worksheets("sheet2")

With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
For r = 2 To lastrow '<=== assumes data starts in row 2
v = Split(.Cells(r, "D"), ",")
For i = LBound(v) To UBound(v)
.Range("a" & r & ":c" & r).Copy ws2.Cells(Rows.Count,
"A").End(xlUp)(2)
ws2.Cells(ws2.Cells(Rows.Count, "A").End(xlUp).Row, "D") = v(i)
Next i
Next r
End With

End Sub


HTH

 

[lbarky]

Toppers

Many thanks for your time, its worked