frank_m
01-22-2011, 05:41 AM
I'm trying to make X copies of the selected row, but my code as I have it now is only making one copy regardless of the number that I enter in the inputbox.
Please inform me of the error in my ways :dunno
I know it's a silly mistake that I'm a bit too tired to spot at the moment,
-- your help is appreciated.
Thanks :)
Sub Copy_Record_X_Times()
Dim X As Variant
beginning:
X = Application.InputBox("Please enter the number of copies you need for the selected row.")
If Not IsNumeric(X) Then
MsgBox "Only a number can be entered"
GoTo beginning
End If
If X = False Then
MsgBox "Canceled"
Exit Sub
Else
For X = 1 To X
ActiveCell.EntireRow.Copy
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(1, 6 - ActiveCell.Column).ClearContents 'clear col 6 cell for each copy
ActiveCell.Offset(1, 10 - ActiveCell.Column).ClearContents 'clear col 10 cell for each copy
ActiveCell.Offset(1, 12 - ActiveCell.Column).ClearContents 'clear col 12 cell for each copy
ActiveCell.Offset(1, 13 - ActiveCell.Column).ClearContents 'clear col 13 cell for each copy
ActiveCell.Offset(1, 14 - ActiveCell.Column).ClearContents 'clear col 14 cell for each copy
Next
End If
End Sub
Please inform me of the error in my ways :dunno
I know it's a silly mistake that I'm a bit too tired to spot at the moment,
-- your help is appreciated.
Thanks :)
Sub Copy_Record_X_Times()
Dim X As Variant
beginning:
X = Application.InputBox("Please enter the number of copies you need for the selected row.")
If Not IsNumeric(X) Then
MsgBox "Only a number can be entered"
GoTo beginning
End If
If X = False Then
MsgBox "Canceled"
Exit Sub
Else
For X = 1 To X
ActiveCell.EntireRow.Copy
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(1, 6 - ActiveCell.Column).ClearContents 'clear col 6 cell for each copy
ActiveCell.Offset(1, 10 - ActiveCell.Column).ClearContents 'clear col 10 cell for each copy
ActiveCell.Offset(1, 12 - ActiveCell.Column).ClearContents 'clear col 12 cell for each copy
ActiveCell.Offset(1, 13 - ActiveCell.Column).ClearContents 'clear col 13 cell for each copy
ActiveCell.Offset(1, 14 - ActiveCell.Column).ClearContents 'clear col 14 cell for each copy
Next
End If
End Sub