Transpose cells separated with "," and duplicate data in rows

[SVDCF]

Hello everyone!

I am new to this forum and I would like to raise a question regarding the thread :
http://www.mrexcel.com/forum/excel-...utomatically-insert-new-rows.html#post4521996

I would like to do this same operation but the column I want to replicate is in column "HT".

How can I change this macro do to the transpose in column "HT"?

Additionally, why I am always getting the following error "Mismatch" highlighting the "Sheets("sheet1").Range("a1").Resize(c, UBound(Ray, 2)) = Application.Transpose(nray)".

I have no idea how to correct it.

Appreciated!

K.Regards
Sara


Sub som()
Dim Ray As Variant, n As Long, Sp As Variant, c As Long, s As Long, Ac As Long
Ray = ActiveSheet.Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 2), 1 To 1)


For n = 1 To UBound(Ray, 1)
Sp = Split(Ray(n, 2), ",")
For s = 0 To UBound(Sp)
c = c + 1
ReDim Preserve nray(1 To UBound(Ray, 2), 1 To c)
For Ac = 1 To UBound(Ray, 2)
If Ac = 2 Then
nray(Ac, c) = Sp(s)
Else
nray(Ac, c) = Ray(n, Ac)
End If
Next Ac
Next s
Next n
Sheets("sheet1").Range("a1").Resize(c, UBound(Ray, 2)) = Application.Transpose(nray)
MsgBox "Run"
End Sub

 

[MickG]

You could try:-
Sp = Split(Ray(n, 228), ",")

228 being column "Ht"
Please post Data example if this does not work

 

[sheetspread]

This works too if you want:

http://www.mrexcel.com/forum/excel-...omma-delimited-date-parsed-separate-rows.html

 

[sheetspread]

Macroless:

https://vimeo.com/173284995

 

[SVDCF]

You could try:-
Sp = Split(Ray(n, 228), ",")

228 being column "Ht"
Please post Data example if this does not work

Hi MickG!

Thank you for that! I was wondering where the cell value would go.

I just have a minor problem now, the mismatch error : run time error 13

"Sheets("sheet1").Range("a1").Resize(c, UBound(Ray, 2)) = Application.Transpose(nray)"

am I using wrong names for the sheets? what names should i use for the source sheet and the result sheet?

 

[SVDCF]

hello Sheetspread!
There is one little thing i need extra, the data should be copied in the duplicated rows.

I am going to check the video you sent

Thank you!
Sara

 

[sheetspread]

the data should be copied in the duplicated rows.

The macro does this, but has to be changed slightly if your column containing delimited values is 228 instead of 1. Also tell me on which row the data begins if not row 2.

Since you have multiple labeling columns, the method described in the video would require that they be concatenated first.

 

[MickG]

The Data sheet is the Active sheet .
The results sheet is shown as sheet1, but you can change it as required.

 

[SVDCF]

The macro does this, but has to be changed slightly if your column containing delimited values is 228 instead of 1. Also tell me on which row the data begins if not row 2.

Since you have multiple labeling columns, the method described in the video would require that they be concatenated first.

Yes! the column with the values in number 228 and the data starts on row 2

 

[sheetspread]

Without knowing where your columns start, I tried this and it worked:

Excel 2010
	HT	HU	HV	HW	HX
1	Cust part	Our parts	Our ID	Currency	Price
2	135649A1, A75262	Part AD	1E+08	USD	$18.95
3	138642, BN98510, 190585R91	Part O	1E+08	USD	$7.82
4	163044, BN98509	Part W	1E+08	USD	$4.57
5	179080, BSET2	Part U	1E+08	USD	$3.97
6	18427, ST791	Part P	1E+08	USD	$7.82
7	21076D, E3NN3123AA, 210760	Part N	1E+08	USD	$3.66
8	44401, 694735 CONE, ST775A	Part C	1E+08	USD	$6.44
9	459456R91, 86576982 - CONE, 273423	Part L	1E+08	USD	$3.83
10	47508360, 52443, 664175R92	Part F	1E+08	USD	$13.22
Sheet3 (3)

Sub parsetranspose()
Dim x%, y%, partarray As Variant
x = 2
Do Until Cells(x, 228).Value = ""
y = Len(Cells(x, 228)) - Len(Replace(Cells(x, 228).Value, ",", ""))
If y > 0 Then
ReDim partarray(y)
partarray = Split(Cells(x, 228).Value, ",")
Rows(x + 1).Resize(y).Insert
Range("HT" & x).Resize(y + 1).Value = Application.Transpose(partarray)
Range("HU" & x & ":HX" & x).Resize(y + 1).Value = Range("HU" & x & ":HX" & x).Value
Else
End If
x = x + y + 1
Loop
End Sub

Excel 2010
	HT	HU	HV	HW	HX
1	Cust part	Our parts	Our ID	Currency	Price
2	135649A1	Part AD	100110399	USD	$18.95
3	A75262	Part AD	100110399	USD	$18.95
4	138642	Part O	100027144	USD	$7.82
5	BN98510	Part O	100027144	USD	$7.82
6	190585R91	Part O	100027144	USD	$7.82
7	163044	Part W	100026523	USD	$4.57
8	BN98509	Part W	100026523	USD	$4.57
9	179080	Part U	100045902	USD	$3.97
10	BSET2	Part U	100045902	USD	$3.97
11	18427	Part P	100047915	USD	$7.82
12	ST791	Part P	100047915	USD	$7.82
13	21076D	Part N	100050683	USD	$3.66
14	E3NN3123AA	Part N	100050683	USD	$3.66
15	210760	Part N	100050683	USD	$3.66
16	44401	Part C	100055719	USD	$6.44
17	694735 CONE	Part C	100055719	USD	$6.44
18	ST775A	Part C	100055719	USD	$6.44
19	459456R91	Part L	100096658	USD	$3.83
20	86576982 - CONE	Part L	100096658	USD	$3.83
21	273423	Part L	100096658	USD	$3.83
22	47508360	Part F	100081326	USD	$13.22
23	52443	Part F	100081326	USD	$13.22
24	664175R92	Part F	100081326	USD	$13.22
Sheet3 (3)