VBA Transpose and separate comma separated values

[decadence]

Hi, I am trying to separate comma separated text in multiple cells in a column but would like to retain the exact same date for each row of separated text except for Quantity and the transposed references. Also I will have varied rows of data in the reference column, Can some one help with this please.

From this

[TABLE="width: 200"]
<tbody>[TR]
[TD]Header[/TD]
[TD]Header[/TD]
[TD]Header[/TD]
[TD]Header[/TD]
[TD]Reference[/TD]
[TD]Quantity[/TD]
[/TR]
[TR]
[TD]There[/TD]
[TD]are[/TD]
[TD]some[/TD]
[TD]Apples[/TD]
[TD]Red,Green,Yellow,Blue[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]This[/TD]
[TD]is not[/TD]
[TD]an [/TD]
[TD]Orange[/TD]
[TD]White,Black[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]


to this


[TABLE="width: 200"]
<tbody>[TR]
[TD]Header[/TD]
[TD]Header[/TD]
[TD]Header[/TD]
[TD]Header[/TD]
[TD]Reference[/TD]
[TD]Quantity[/TD]
[/TR]
[TR]
[TD]There[/TD]
[TD]are[/TD]
[TD]some[/TD]
[TD]Apples[/TD]
[TD]Red[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]There[/TD]
[TD]are[/TD]
[TD]some[/TD]
[TD]Apples[/TD]
[TD]Green[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]There[/TD]
[TD]are[/TD]
[TD]some[/TD]
[TD]Apples[/TD]
[TD]Yellow[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]There[/TD]
[TD]are[/TD]
[TD]some[/TD]
[TD]Apples[/TD]
[TD]Blue[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]This[/TD]
[TD]is not[/TD]
[TD]an[/TD]
[TD]Orange[/TD]
[TD]White[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]This[/TD]
[TD]is not[/TD]
[TD]an[/TD]
[TD]Orange[/TD]
[TD]Black[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]

 

[GTO]

Excel Workbook
	A	B	C	D	E	F
2	There	are	some	Apples	Red, Green,Yellow,Blue	5
Sheet1

Excel 2010

Will the number of reference always equal quantity, or might the above occur?

 

[MickG]

Try this for results sting "H1".

[COLOR="Navy"]Sub[/COLOR] MG04Sep44
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Sp [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Offset(, 4), ",")
    Cells(c, "H").Resize(UBound(Sp) + 1, 4).Value = Dn.Resize(, 4).Value
    Cells(c, "L").Resize(UBound(Sp) + 1).Value = IIf(UBound(Sp) > 0, Application.Transpose(Sp), Dn.Offset(, 4).Value)
    Cells(c, "M").Resize(UBound(Sp) + 1).Value = 1
    c = c + UBound(Sp) + 1
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[decadence]

Hi GTO, Yes it may occur as the data is varied.

Hi MickG, Your code works, but can it be changed so the headers are not included so it starts in row 2, also is it possible to do it in the same columns and get the same result as your code? Many Thanks

 

[MickG]

Change the second line to range("A2") from range("A1").

also is it possible to do it in the same columns and get the same result as your code?

I'm not sure what this means ???