- VBA - how to replicate the value n times
- Excel - Repeat rows a specified number of times » How-To - Excel
- VBA - Duplicate a value n number of times » How-To - Excel
- Excel - Copy and insert rows n number of times » How-To - Excel
- How to get a value in a cell n times » Forum - Office software
- VBA - how to repeat a set number of values X times » Forum - Excel
5 replies
your data is from A1 to A3
try this macro
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
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!!
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
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
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
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!