Search code examples
excelvbaxlsm

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


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.


Solution

  • 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