VBA to Reverse a string of delimited and hyphenated text.

[decadence]

Hi, Is it possible to split hyphenated and delimited text into the next row but keep the data in the same rows?

example

From This

What	Who	When	Why
Apples	Pie	Something	A1-A3,A5,A7-A10
Banana	Split	Nothing	D1,D2,D8-D9
Candy	Cane	Everything	B1,B3-B6

<tbody>
</tbody>

To This

What	Who	When	Why
Apples	Pie	Something	A1
Apples	Pie	Something	A2
Apples	Pie	Something	A3
Apples	Pie	Something	A5
Apples	Pie	Something	A7
Apples	Pie	Something	A8
Apples	Pie	Something	A9
Apples	Pie	Something	A10
Banana	Split	Nothing	D1
Banana	Split	Nothing	D2
Banana	Split	Nothing	D8
Banana	Split	Nothing	D9
Candy	Cane	Everything	B1
Candy	Cane	Everything	B3
Candy	Cane	Everything	B4
Candy	Cane	Everything	B5
Candy	Cane	Everything	B6

<tbody>
</tbody>

 

[MickG]

Try this for result starting "F1".

[COLOR="Navy"]Sub[/COLOR] MG07Nov15
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Sp [COLOR="Navy"]As[/COLOR] Variant, SSp [COLOR="Navy"]As[/COLOR] Variant, Ray(), n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oLet [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Fst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To 4, 1 To 1)
Ray(1, 1) = "What": Ray(2, 1) = "Who": Ray(3, 1) = "When": Ray(4, 1) = "Why"
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Offset(, 3).Value, ",")
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
        [COLOR="Navy"]If[/COLOR] InStr(Sp(n), "-") > 0 [COLOR="Navy"]Then[/COLOR]
                SSp = Split(Sp(n), "-")
                oLet = Left(Sp(n), 1)
                Fst = Replace(SSp(0), oLet, "")
                Lst = Replace(SSp(1), oLet, "")
                [COLOR="Navy"]For[/COLOR] nn = Fst To Lst
                    c = c + 1
                    ReDim Preserve Ray(1 To 4, 1 To c)
                    Ray(1, c) = Dn.Value: Ray(2, c) = Dn.Offset(, 1).Value
                    Ray(3, c) = Dn.Offset(, 2).Value: Ray(4, c) = oLet & nn
                [COLOR="Navy"]Next[/COLOR] nn
        [COLOR="Navy"]Else[/COLOR]
                    c = c + 1
                    ReDim Preserve Ray(1 To 4, 1 To c)
                    Ray(1, c) = Dn.Value: Ray(2, c) = Dn.Offset(, 1).Value
                    Ray(3, c) = Dn.Offset(, 2).Value: Ray(4, c) = Sp(n)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] Range("F1").Resize(c, 4)
    .Value = Application.Transpose(Ray)
    .Borders.Weight = 2
    .Columns.AutoFit
 [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[decadence]

Thank you MickG, You sir are a legend.

 

[MickG]

You're welcome