Cut and paste a set of rows to allow a new blank row

Question

I am putting together a project management excel spreadsheet (my company won't fork out for licenses for everyone to have access to anything like MS Project or suchlike, and I'd like something everyone can use), and would like the user to be able to add or delete rows wherever they specify (I'm using a userform to make it easier to use). I am having issues copying, cutting and pasting rows to allow for a new blank row.

I want the user to specify the row number where they want to place a new row (with all associated formulae and formatting). At present I'm using Cell "C6" to input the Row number. I'm using a modified variant of code I've successfully used previously which allowed me to copy and paste a new blank row at the bottom of a spreadsheet. I'd like my modified code to copy all rows in the range between the row specified in cell "C6" and the last full row, then offset by one row and paste e.g. if the first row value is 14, and the last row is 50, copy the range(14:50), offset to row 15 and paste.

Once I get this bit right I'll then do the rest of the code to copy/paste and clear into row 14 to give me a new blank formatted row. I'm hoping the code to delete a row will be something along the lines of this in reverse, but I'll get to that later.

At the moment I'm consistently getting an error which I just don't understand - I've tried everything I know to resolve this, and carried out numerous Google searches, but nothing is working!

The error keeps highlighting the 'FirstRow' as an issue, but I've got a number in the cell - I'm at a loss:

Dim rActive As Range
Dim FirstRow As Integer
Dim LastRow As Integer

Set rActive = ActiveCell

Application.ScreenUpdating = False

FirstRow = Range(Range("C6").Value)

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

With Range(FirstRow & ":" & LastRow)
.Copy

With Range(FirstRow).Offset(1, 0)
.PasteSpecial xlPasteAll

On Error Resume Next

End With

End With

rActive.Select

Application.CutCopyMode = False

Application.ScreenUpdating = True

I can see that the correct range is selected and copied, but there is an issue with the subsequent offset.

You have `Range` twice for some reason? Just get rid of one: `FirstRow = Range("C6").Value` — tigeravatar, May 07 '19 at 20:09

score 0 · Accepted Answer · answered May 08 '19 at 00:55

There is a mix up in your variable types FirstRow = Range(Range("C6").Value) will return a RANGE OBJECT (actually it will error because there is no "set").

FirstRow = Range("C6").Value will return an INTEGER OR STRING.

++++++++++++++++++++++++++++++++++

I've done something similar, it isn't the most stellar code, but maybe it will give you some ideas.

Sub AddParticipant()

    Dim msgChoice As VbMsgBoxResult
    Dim NewName As String
    Dim TargetCell As Range

    'Set Up
    ThisWorkbook.Save

    If Range("LastParticipant").Value <> "" Then
        MsgBox "The roster is full. You cannot add anymore participants.", vbCritical
        Exit Sub
    End If

    'Get Name
    NewName = Application.InputBox( _
               Prompt:="Type the participant's name as you would like it to appear on 
                         this sheet.", _
               Title:="Participant's Name", _
               Type:=2)

        'Error Message
        If NewName = "" Then
            MsgBox ("You did not enter a name.")
            Exit Sub
        End If

    'Get Location (with Data Validation)
GetTargetCell:
    Set TargetCell = Application.InputBox _
           (Prompt:="Where would you like to put this person? (Select a cell in 
                 column A)", _
            Title:="Cell Select", _
            Type:=8)
    If TargetCell.Count > 1 Then
        MsgBox "Select a single cell in Column A"
        GoTo GetTargetCell
    End If

    If TargetCell.Column <> 1 Then
        MsgBox "Select a single cell in Column A"
        GoTo GetTargetCell
    End If

    If TargetCell.Offset(-1, 0) = "" Then
        MsgBox "You must pick a contiguous cell. No blank spaces allowed!"
        GoTo GetTargetCell
    End If


    If TargetCell <> "" Then

        'Do stuff to populate rows or shift data around

    Else
        'If they picked a blank cell, you can insert new data
        TargetCell.Value = NewName

    End If


End Sub

thanks - I'm still getting my head around the Range thing! – Jimbo100 May 08 '19 at 08:29 — Jimbo100, May 08 '19 at 08:29

score 0 · Answer 2 · answered May 08 '19 at 08:27

Thanks!! I'd been too liberal with the 'Range'. Code is now:

Dim rActive As Range Dim FirstRow As Integer Dim LastRow As Integer

Set rActive = ActiveCell

Application.ScreenUpdating = False

FirstRow = Range("C6").Value

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

With Range(FirstRow & ":" & LastRow) .Copy

With .Offset(1, 0) .PasteSpecial xlPasteAll

On Error Resume Next

End With

rActive.Select

Application.CutCopyMode = False

Application.ScreenUpdating = True

It works perfectly! Just need to do the rest of it now...

Cut and paste a set of rows to allow a new blank row

2 Answers2