Duplicate rows and separate by comma delimited list in last cell

[jcasual]

At work I often have an excel sheet with many columns. The cell in the last column of each row has a comma delimited list. I'd like to duplicate each row and separate the last cell into each section of the delimited list. For example if my table looks like this:

Kansas City	Custom	Display	a, b, c
St. Louis	Rem	Display	d, e

<tbody>
</tbody>

I would like to create this:

Kansas City	Custom	Display	a
Kansas City	Custom	Display	b
Kansas City	Custom	Display	c
St. Louis	Rem	Display	d
St. Louis	Rem	Display	e

<tbody>
</tbody>

Not sure what the best way is to go about this. Perhaps I need to create an array for each row of the last cell and say for each value in that array create a new row and copy the values down? I haven't played in VBA for a while. Often my original excel documents have 50 rows and many more columns with an assortment of values, so separating everything becomes tedious and time consuming. Any advice is appreciated. Thanks!

 

[MickG]

Try this:-
NB:- The code assumes you data start row2.
NB:- The Results are posted on sheet3 Starting "A2".

[COLOR="Navy"]Sub[/COLOR] MG18Jul53
[COLOR="Navy"]Dim[/COLOR] Ray, Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To UBound(Ray, 2))
[COLOR="Navy"]For[/COLOR] Rw = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(Rw, Ac)) [COLOR="Navy"]Then[/COLOR]
            Temp = Ray(Rw, Ac): col = Ac
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
Sp = Split(Temp, ",")
    [COLOR="Navy"]For[/COLOR] R = 0 To UBound(Sp)
        c = c + 1
        [COLOR="Navy"]For[/COLOR] n = 1 To col
            nray(c, n) = IIf(n = col, Sp(R), Ray(Rw, n))
        [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] Rw
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet3").Range("a2").Resize(c, UBound(Ray, 2))
        .Value = nray
        .Columns.AutoFit
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick