Home > Software engineering >  Insert Row on Button Click
Insert Row on Button Click

Time:11-06

I have the following code, which I got from this community, which allows me to double click on a cell and insert a row below. It inserts the row then goes back to columns E through R, as well as column T, and clears contents.

All I want to do is take the same code and apply it to a button click instead of a double click (people here at work use double click to edit the cell).

Here's the double-click code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    Target.Offset(1).EntireRow.Insert
    Target.EntireRow.Copy Target.Offset(1).EntireRow
     Intersect(Target.Offset(1).EntireRow, Range("E:R,T:T")).ClearContents
End Sub

I tried several other codes (found on StackOverflow) that I was just going to modify to go back and ClearContents, but I keep getting errors.

Two other codes I've tried are:

Public Sub insertRowBelow()
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End Sub

and

Sub InsertRow()
r = Selection.Row
Cells(r   1, 1).EntireRow.Insert
Cells(r, 1).Copy Destination:=Cells(r   1, 1)
End Sub

On both, I get "Variable not defined" errors:

enter image description here

enter image description here

The end goal is for the user to click on a cell, click the button, it copies down the formulas from the line above, and then ClearContents in columns E through R, as well as column T (for only that newly inserted row, not ClearContents for the entire column!)

BONUS COOL POINTS: if you're able to make it so they can't add a row if they are above row 5, that'd be fantastic. Rows 1, 2, 3, and 4, are all header / information type rows, so if they click in any of those (or don't know the active cell is up there) and click this button, since you can't undo VBA, it could mess up the header section pretty good. So they would have to activate a cell in row 5 or below for this to work, that would be the icing on the cake.

Triple cool points if we can add a msg box that says "Please select a cell in row 5 or below" so they don't just think the button's broken... that would be the best of the best of the best.

Thanks for any help in advance!!

CodePudding user response:

Insert a Row Below

Option Explicit

Sub InsertRowBelow()
    Const ProcTitle As String = "Insert a Row Below"
    
    Const msgRange As String = "Please select a cell."
    Const msgRowMin As String = "Please select a cell below row 4."
    Const msgRowMax As String = "Please select a cell above the last row."
    
    On Error GoTo ClearError ' e.g. worksheet is protected
    
    If TypeName(Selection) = "Range" Then
        With Selection.Cells(1).EntireRow ' consider only the first cell's row
            If .Row > 4 Then
                If .Row < .Worksheet.Rows.Count Then
                    .Copy
                    .Offset(1).Insert xlShiftDown ' , xlFormatFromLeftOrAbove
                    Intersect(.Offset(1), .Worksheet.Range("E:R,T:T")) _
                        .ClearContents ' sets 'Application.CutCopyMode' to False
                Else ' '.Row = .Worksheet.Rows.Count' (last Row)
                    MsgBox msgRowMax, vbCritical, ProcTitle
                End If
            Else ' '.Row <= 4'
                MsgBox msgRowMin, vbCritical, ProcTitle
            End If
        End With
    Else ' 'Selection' is not a range (e.g. it's a shape)
        MsgBox msgRange, vbCritical, ProcTitle
    End If

ProcExit:
    Exit Sub
ClearError:
    MsgBox "Unexpected Error" & vbLf & vbLf _
        & "Run-time error '" & Err.Number & "':" & vbLf _
        & Err.Description, vbCritical, ProcTitle
    'If Application.CutCopyMode Then Application.CutCopyMode = False
    Resume ProcExit
End Sub
  • Related