Duplicate one specific row only up to a range for multiple times based on Input box value using VBA

Question

In my sheet I have 5 columns filled with data and when I double click on any cell it will show Input box to enter "Number of rows" and copies multiple times. Till here everything works fine but my requirement is to only copy two columns data (A & B) and clear the Contents of other column data only for the created new rows.

My Excel data:

Present Solution is:

My Requirement should look like below:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim xCount As Integer
LableNumber:
    xCount = Application.InputBox("Number of Rows", "Copy previous data of Team and Place", , , , , , 1)
    If xCount < 1 Then
        MsgBox "the entered number of rows is error, please enter again", vbInformation
        GoTo LableNumber
    End If
    ActiveCell.EntireRow.Copy
    'copy and move down
    Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(xCount, 0)).EntireRow.Insert Shift:=xlDown

    'clear the contents only for new rows added from the column C to column D
    Sheets(ActiveSheet.Name).Range(ActiveCell.Offset(1, 4), ActiveCell.Offset(1, 4)).Select

    Selection.ClearContents

    Application.CutCopyMode = False

End Sub

I'd recommend avoiding the use of [`.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba), that could be part of the issue. You have `Target`, but don't use it in the code... — BruceWayne, Nov 04 '19 at 15:05
Ok but in "Target" how to define a range only from Column 3 to 5. — sant, Nov 04 '19 at 15:09
You mean this way`Set rng = ThisWorkbook.Worksheets("Sheet1").Range("C:E")` — sant, Nov 04 '19 at 15:10

score 2 · Accepted Answer · answered Nov 04 '19 at 15:14

2

Try this. As Bruce says, you can avoid Select and use Target as it is intended to be.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column > 5 Then Exit Sub 'only applies if A-E double-clicked

Dim xCount As Long
Cancel = True                      'prevent default behaviour of cell edit mode

Do                                 'keep asking until >=1
    xCount = Application.InputBox("Number of Rows", "Copy previous data of Team and Place", , , , , , 1)
    If xCount >= 1 Then Exit Do
    MsgBox "the entered number of rows is error, please enter again", vbInformation
Loop

With Cells(Target.Row, 1)                              'reference point column A of whichever row clicked
    .Resize(, 5).Copy                                  'copy 5 columns across
    .Offset(1).Resize(xCount, 5).Insert Shift:=xlDown  'insert as many rows
    .Offset(1, 2).Resize(xCount, 3).ClearContents      'clear C-E
End With

End Sub

answered Nov 04 '19 at 15:14

SJR

22,986
6
18
26

Thanks alot works perfect!! I understood the importance of not using **Selection/Activate** – sant Nov 04 '19 at 15:25
The only issue I realised is the Code not working when I apply filter and do a double click. – sant Nov 04 '19 at 15:30
When I apply filter in the Excel sheet and double click to copy I get this error `The Insert method of the Range object could not be executed.` – sant Nov 04 '19 at 15:42
I think you'd have to remove the filter, insert the lines, and then reapply. – SJR Nov 04 '19 at 15:47
Without filter it works perfect but the user needs to filter and add the new rows!! is this possible? – sant Nov 05 '19 at 06:57
Did you try the approach I mentioned before? If you have a filter applied you will need to store the settings before inserting the rows - you can find code for this online - ask a new question if you get stuck. – SJR Nov 05 '19 at 10:20

Duplicate one specific row only up to a range for multiple times based on Input box value using VBA

1 Answers1