View Single Post
 
Old 07-10-2014, 09:06 PM
excelledsoftware excelledsoftware is offline Windows 7 64bit Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Here is some code that should do it. You will need to change the FinalRow. Please be careful when running this code because it will delete all the data below whatever you paste. Have a backup and then try it. Also this procedure is to be used when you are about to paste your data. Meaning it pastes the data for you. Just select the cell where you want to paste and then run the code. You may want to attach the code to an autoshape on your worksheet.

Code:
Sub DeleteAfterPaste()

'IMPORTANT this code will DELETE data from a worksheet.  Be sure to only have the affected workbook open
'when running.


  Dim c As Variant
  Dim LastPasteRow As Long, FinalRow As Long, DataRows As Long
  
    FinalRow = 3000 'Change this to the final row of data.
  
    On Error GoTo Clipboardempty
  
    ActiveSheet.Paste
    On Error GoTo 0 'return errors back to normal.
    
    'Run a loop to find the last row
    For Each c In Selection
      LastPasteRow = c.Row
    Next c
    
    DataRows = WorksheetFunction.CountA(Range(LastPasteRow + 1 & ":" & FinalRow))
    If DataRows = 0 Then
      End 'Ends the program because nothing is below
    Else
      'This is the command that deletes everything below.
      Range(LastPasteRow + 1 & ":" & FinalRow).ClearContents
    End If
    
    End
Clipboardempty:
  'Checks if the clipboard is empty and if so halts execution
  MsgBox "Nothing to paste, program ending."
  End
  
End Sub
Let me know if you have any questions.

Thanks
Reply With Quote