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.
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
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!
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
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!!
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
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!