Copy cells in a loop

[kubabocz]

Hi,

Iam struggling with VBA. I have data in column A and want it to be copied amount of times that is represented in corresponding cell in column B.
So going from part on the left to the one that is on right

Of course the number of items in column A can vary.

Thank you

 

[frank_AL]

Give me a little bit and I will provide you a solution.

 

[skillilea]

I think this works.

Public Sub CopyIt()
Dim rng As Range
Dim i As Integer, x As Integer
Dim arCnt As Integer: arCnt = 1
Dim copyX As Integer
Dim ar() As Variant

Set rng = Sheet1.Range("A1:B3") ' get your range

For i = 1 To rng.Rows.Count
copyX = rng.Cells(i, 2).Value

ReDim Preserve ar(1 To arCnt + copyX - 1)

For x = 1 To copyX
ar(arCnt) = rng.Cells(i, 1).Value
arCnt = arCnt + 1
Next
Next

Set rng = Sheet1.Range("F1")

Set rng = rng.Resize(UBound(ar, 1))

rng.Value = Application.Transpose(ar)

End Sub

 

[skillilea]

Depending on what you are trying to do and how big your dataset is. I'd read the whole range into an array first and work with that then once to the sheet.

 

[frank_AL]

Here's a solution for you.

Option Explicit

Sub CopyData()

Dim i As Long
Dim x As Long
Dim y As Long
Dim z As Long
Dim lr As Long
Dim CurrWS As Worksheet

Set CurrWS = ActiveSheet

lr = CurrWS.Cells(Rows.Count, "A").End(xlUp).Row  ' Determine last row of data in Column A
z = 1
For i = 1 To lr
    x = CurrWS.Cells(i, "B").Value
    For y = 1 To x
        CurrWS.Range("G" & z).Value = CurrWS.Range("A" & i).Value
        z = z + 1
    Next
Next

End Sub

Things to consider:
Variables i, x, y, z & lr can be defined as Integer instead of Long if there will be fewer that 32,767 rows of data.

 

[kubabocz]

Here's a solution for you.

Option Explicit

Sub CopyData()

Dim i As Long
Dim x As Long
Dim y As Long
Dim z As Long
Dim lr As Long
Dim CurrWS As Worksheet

Set CurrWS = ActiveSheet

lr = CurrWS.Cells(Rows.Count, "A").End(xlUp).Row  ' Determine last row of data in Column A
z = 1
For i = 1 To lr
    x = CurrWS.Cells(i, "B").Value
    For y = 1 To x
        CurrWS.Range("G" & z).Value = CurrWS.Range("A" & i).Value
        z = z + 1
    Next
Next

End Sub

Things to consider:
Variables i, x, y, z & lr can be defined as Integer instead of Long if there will be fewer that 32,767 rows of data.

This works perfectly, thank you so much