How to expand data

[ouadad]

I have data that looks like this:
# of parts cost per part
100 36.50
200 25.00
10 34.95
.
.
.
68,000 values

and I need to expand the list so that it's a list of, for example, 100 rows of 36.50, 200 rows of 25.00, 10 rows of 34.95,etc.. The goal is to calculate a cumulative cost of all parts.

 

[ranman256]

put this code into a module ,
then run ExapandVals

Sub ExapandVals()
Dim shSrc As Worksheet, shTarg As Worksheet
Dim iQty As Integer
Dim nTot As Currency
Dim vCost
Set shSrc = ActiveSheet
Sheets.Add
Set shTarg = ActiveSheet
shSrc.Activate
Range("A2").Select
While ActiveCell.Value <> ""
iQty = ActiveCell.Value
vCost = ActiveCell.Offset(0, 1).Value

For i = 1 To iQty
shTarg.Activate
ActiveCell.Value = vCost
nTot = nTot + vCost
ActiveCell.Offset(0, 1).Value = nTot

ActiveCell.Offset(1, 0).Select 'next row
Next

shSrc.Activate
ActiveCell.Offset(1, 0).Select 'next row
nTot = 0
Wend
End Sub

 

[Snakehips]

Is it absolutely necessary for you to expand the list?

Does something like this help?

Book1
	A	B	C
1		Qty	Cost
2	100 36.50	100	3,650.00
3	200 25.00	200	5,000.00
4	10 34.95	10	349.50
Sheet1

Cell Formulas
Range	Formula
B2:B4	B2	=TRIM(LEFT(SUBSTITUTE(TRIM(A2)," ",REPT(" ",20),1),10))
C2:C4	C2	=IFERROR(B2*TRIM(RIGHT(SUBSTITUTE(TRIM(A2)," ",REPT(" ",20),1),10)),"")

 

[ouadad]

Thanks Ranman256. Yes, Snakehips it's necessary to generate a cumulative cost for all parts rather than bunches of parts.

 

[mse330]

This is another macro that does the same thing but should be significantly faster

Sub AddLines()

Dim a, j&: j = 1
a = [A1].CurrentRegion

ReDim b(1 To [sum(A:A)], 1 To 2)
For x = 1 To UBound(a)
    For i = j To a(x, 1) + j - 1
        b(i, 1) = a(x, 2)
        b(i, 2) = IIf(j = 1, a(x, 2) * i, a(x, 2) * (i - j + 1))
    Next
    j = j + a(x, 1)
Next

Sheets.Add(, ActiveSheet).[A1].Resize(UBound(b), 2) = b

End Sub