copying cells based on a cell value

[andysh]

Hi,

I'm trying to achieve the following and hoping someone can help with the VBA.

I need to copy rows a number of times based on a cell quantity and then set the quantity in each row to one.

So something like:

for each row:
if (cell C) > 1:
copy row and insert (cell C - 1) times
change (cell C) in each row to 1

The outcome would change this:

aaaa	aaaa	3	aaaa	aaaa	aaaa
bbbb	bbbb	2	bbbb	bbbb	bbbb
cccc	cccc	1	cccc	cccc	cccc
dddd	dddd	2	dddd	dddd	dddd

into this:

aaaa	aaaa	1	aaaa	aaaa	aaaa
aaaa	aaaa	1	aaaa	aaaa	aaaa
aaaa	aaaa	1	aaaa	aaaa	aaaa
bbbb	bbbb	1	bbbb	bbbb	bbbb
bbbb	bbbb	1	bbbb	bbbb	bbbb
cccc	cccc	1	cccc	cccc	cccc
dddd	dddd	1	dddd	dddd	dddd
dddd	dddd	1	dddd	dddd	dddd

Hope that makes sense and someone can help

 

[JEC]

When your data starts in A1:

Sub jvr()
 ar = Sheets(1).Cells(1, 1).CurrentRegion
 
 With CreateObject("scripting.dictionary")
   For i = 1 To UBound(ar)
      For j = 1 To ar(i, 3)
        .Item(.Count) = Application.Index(ar, i, 0)
      Next
    Next
   Sheets(1).Cells(1, 1).Resize(.Count, UBound(ar, 2)) = Application.Index(.items, 0, 0)
  Sheets(1).Cells(1, 3).Resize(.Count) = 1
 End With
End Sub

 

[andysh]

That's perfect, which row of code would I tweak to get it to start on row 3 and give me a couple of header rows?

 

[andysh]

Apologies for bumping but could do with some help if anyone can answer the above question.

 

[JEC]

Try for i= 3 to ….

 

[JEC]

Also change the last 2 lines of code. That is your "paste" destination

 

[andysh]

Thanks for that JEC, perfect solution now