Multiple comma delimited date parsed to separate rows

[YaYa08]

Column A has multiple Cust parts. I need to separate the Cust part to individual rows with the other data in the columns matched.

Here is an example of the first row as it should appear:

Excel 2010
	G	H	I	J	K
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
Example

Here is my data:

Excel 2010
	A	B	C	D	E
1	Cust part	Our parts	Our ID	Currency	Price
2	135649A1, A75262	Part AD	100110399	USD	$18.95
3	138642, BN98510, 190585R91	Part O	100027144	USD	$ 7.82
4	163044, BN98509	Part W	100026523	USD	$ 4.57
5	179080, BSET2	Part U	100045902	USD	$ 3.97
6	18427, ST791	Part P	100047915	USD	$ 7.82
7	21076D, E3NN3123AA, 210760	Part N	100050683	USD	$ 3.66
8	44401, 694735 CONE, ST775A	Part C	100055719	USD	$ 6.44
9	459456R91, 86576982 - CONE, 273423	Part L	100096658	USD	$ 3.83
10	47508360, 52443, 664175R92	Part F	100081326	USD	$13.22
Example

 

[sheetspread]

Sub parsetranspose()
Dim x%, y%, partarray As Variant
x = 2
Do Until Cells(x, 1).Value = ""
y = Evaluate("=LEN(A" & x & ")-LEN(SUBSTITUTE(A" & x & ","","",""""))")
ReDim partarray(y)
partarray = Split(Cells(x, 1).Value, ",")
Rows(x + 1).Resize(y).Insert
Range("A" & x).Resize(y + 1).Value = Application.Transpose(partarray)
Range("B" & x & ":E" & x).Resize(y + 1).Value = Range("B" & x & ":E" & x).Value
x = x + y + 1
Loop
End Sub

 

[sheetspread]

you don't need the evaluate, those functions are also available in vba

y = Len(Cells(x, 1)) - Len(Replace(Cells(x, 1).Value, ",", ""))

 

[YaYa08]

This appears to have worked! Thanks so much

 

[YaYa08]

you don't need the evaluate, those functions are also available in vba

y = Len(Cells(x, 1)) - Len(Replace(Cells(x, 1).Value, ",", ""))

I'm not sure I understand. The previous vba code you provided works so how does this affect what you already provided?

 

[YaYa08]

Nevermind about my comment to explain the "evaluate" code. I figured it out.

One more question. Not all the "Cust Part" need to be parsed because they may only contain 1 Cust Part.

The code works if there are always Cust Part(s) with a comma but I am getting the following error at:

Rows(x + 1).Resize.Insert

Can you please provide the necessary adjustment for when the Cust Part field does not contain a comma . Thanks for your help and expertise!

 

[sheetspread]

This?

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

 

[YaYa08]

Bullseye! It works great. Thanks so VERY much.