VBA - how to replicate the value n times

Solved/Closed
gradelle Posts 4 Registration date Friday April 15, 2011 Status Member Last seen April 18, 2011 - Apr 15, 2011 at 02:44 PM
gradelle Posts 4 Registration date Friday April 15, 2011 Status Member Last seen April 18, 2011 - Apr 18, 2011 at 06:32 AM
Hello,

I have to write in VBA a macro that allows to replicate value n times (input).
Let's say, I have a list
one
two
three
and I have to repeat it n (=4) times, the result should be in one column:
one
one
one
one
two
two
two
two
three
three
three
three.

Thanks a lot for your help in advance!

3 responses

venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Apr 15, 2011 at 10:13 PM
your data is from A1 to A3

try this macro

Sub test()
Dim r As String, n As Integer
n = InputBox("type number of times to be replicated")
 r = InputBox("the cells address whose values to be replciated, e.g A2    ")
Range(Range(r).Offset(1, 0), Range(r).Offset(n - 1, 0)).EntireRow.Insert
Range(r).Copy Range(Range(r).Offset(1, 0), Range(r).Offset(n - 1, 0))
End Sub
0
gradelle Posts 4 Registration date Friday April 15, 2011 Status Member Last seen April 18, 2011
Apr 16, 2011 at 02:28 AM
Thanks for your help! It works for A1-A3, but only for one line. If I try to input as address a range of cells A1:A3 it doesn't work.
My real list contains about 120 lines, And each line should be replicated up to 50 times, but this N (50 times) is constant for all 120 values. It doesn't change. Thanks again!
0
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Apr 16, 2011 at 07:59 AM
I am assuming for each row the number of additional times to be replicated may be different. try this

Sub test()  
Dim j As Integer, k As Integer, n As Integer  
j = Range("A1").End(xlDown).Row  

k = 1  

Do  
n = InputBox("type number of ADDITIONAL times to be replicated e.g. 2")  
Range(Cells(k + 1, "A"), Cells(k + n, "A")).EntireRow.Insert  
Cells(k, "A").Copy Range(Cells(k + 1, "A"), Cells(k + n, "A"))  
k = k + n + 1  
'MsgBox k  
If Cells(k, "A") = "" Then Exit Do  
Loop
End Sub
0
gradelle Posts 4 Registration date Friday April 15, 2011 Status Member Last seen April 18, 2011
Apr 16, 2011 at 08:20 AM
thanks!! it works really perfect!!
but could we enter this number "n" only once?.. if I have 120 values in my list to replicate, it takes so much time to enter this n 120 times... Sorry and thanks again!!
0
gradelle Posts 4 Registration date Friday April 15, 2011 Status Member Last seen April 18, 2011
Apr 18, 2011 at 06:32 AM
Option Base 1
Sub auto_open()
Call AddNewMenu
End Sub
Sub DeleteMenu()
On Error Resume Next
CommandBars(1).Controls("&Paste").Delete
End Sub
Sub Macro1()

End Sub

Sub AddNewMenu()
Dim HelpMenu As CommandBarControl
Dim NewMenu As CommandBarPopup
Dim MenuItem As CommandBarControl
Dim SubMenuItem As CommandBarButton

Call DeleteMenu

Set HelpMenu = CommandBars(1).FindControl(ID:=3010)
If HelpMenu Is Nothing Then
Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup, temporary:=True)
Else
Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup, before:=HelpMenu.Index, temporary:=True)
End If
NewMenu.Caption = "&Paste"

Set MenuItem = NewMenu.Controls.Add(Type:=msoControlButton)
With MenuItem
.Caption = "Paste n times"
.FaceId = 162
.OnAction = "Fill"
End With

End Sub


Sub Fill()

Dim Data(1 To 50, 1 To 2) As String
Dim I As Integer, j As Integer, k As Integer
Dim n As Integer
Dim m As Integer


n = InputBox("type the number of the last row in your list e.g if you have 15 lines type 15")
For I = 1 To n
For j = 1 To 1
Data(i, j) = Cells(i, j).Value
Next j
Next i
m = InputBox("type no. of times you want to be repeated")

i = 1
j = 1

With Worksheets("sheet1")
Range("B1:B500").ClearContents
End With

For I = 1 To m * n
Cells(i, 2).Value = Data(j, 1)

If I / m = I \ m Then j = j + 1

Next i

End Sub
0