Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 162
  • Last Modified:

Copying data records by a certain number of time using VBA

Dear Experts:

A copying macro should perform the following tasks:

Run from C2 till the last filled cell in Column C
Take the number of the individual cells in Column C as the number of copies by which the data record is to be copied down (-1)
For example the 'Scissor data' should be listed three times, the Spoon record is to be listed 4 times and the fork record is to be listed twice after running the macro:

Before running macro:

Column A        Column B              Column C
Item_No          Description              Number
17-54               Scissor                            3
17-55               Spoon                            4
17-56               Fork                               2


After running macro:

Item_No      Description      Number
17-54           Scissor                3
17-54           Scissor                3
17-54           Scissor                3
17-55           Spoon                 4
17-55           Spoon                 4
17-55           Spoon                 4
17-55           Spoon                 4
17-56           Fork                     2
17-56           Fork                     2


Help is much appreciated. Thank you very much in advance.

I have attached a sample file for your convenience.

Regards, Andreas

Replicate-Data-Records-using-VBA.xlsm
0
AndreasHermle
Asked:
AndreasHermle
3 Solutions
 
Phillip BurtonCommented:
Please find attached.

So you can extend columns A-C, I have put the results into column E-G.
Replicate-Data-Records-using-VBA.xlsm
0
 
Rory ArchibaldCommented:
Try this:
Sub Replicator()
    Dim vData
    Dim LR                    As Long
    Dim x                     As Long
    Dim y                     As Long
    Dim j                     As Long
    Dim counter               As Long
    Dim vOut()

    LR = Cells(Rows.Count, "C").End(xlUp).row

    vData = Range("A2:C" & LR).Value
    ReDim vOut(1 To Application.Sum(Range("C2:C" & LR)), 1 To UBound(vData, 2))
    counter = 1
    For x = LBound(vData, 1) To UBound(vData, 1)
        For j = 1 To vData(x, 3)
            For y = LBound(vData, 2) To UBound(vData, 2)
                vOut(counter, y) = vData(x, y)
            Next y
            counter = counter + 1
        Next j
    Next x
    Range("A2").Resize(UBound(vOut, 1), UBound(vOut, 2)).Value = vOut
End Sub

Open in new window

0
 
KimputerCommented:
All different code doing the same thing I see :) All finished around the same time too:

Sub test()

UsedRange = ActiveSheet.UsedRange.Rows.Count

For i = UsedRange To 2 Step -1
    j = ActiveSheet.Cells(i, 3)
    For k = j - 1 To 1 Step -1
        Set Rng = ActiveSheet.Range("C" & i).EntireRow
        Rng.Copy
        Rng.Offset(1).Insert Shift:=xlDown
    Next
Next


End Sub

Open in new window


I just went for simplicity and readability (somewhat).
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
AndreasHermleAuthor Commented:
Whow, I am impressed by the speed you answered. Will do some testing shortly and then let you know.

Thank you so much.

Regards, Andreas
0
 
AndreasHermleAuthor Commented:
Great job from all of you. All of them work. I am really glad and you saved my day.
0
 
AndreasHermleAuthor Commented:
Thank you very much for your swift and professional help. You saved me lots and lots of time. What a forum!!! ;-)
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now