Forum Discussion

Ed Hansberry's avatar
Ed Hansberry
Iron Contributor
Apr 26, 2019
Solved

A way to totally and reliably block PASTE operations in Excel with VBA?

We have a workbook that has a lot of tables set up where users are supposed to enter data. These tables are ready by Power Query and/or VBA macros to do things with.   The problem is despite much e...
  • Wyn Hopkins's avatar
    Apr 26, 2019

    Hi Ed Hansberry 

     

    To prevent Cut I use this

     

    Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, _
    ByVal Target As Excel.Range)
    
    'cancel cut mode
    
        Select Case Application.CutCopyMode
            
            Case Is = False
            'do nothing
            
            Case Is = xlCopy
            'do nothing
            
            Case Is = xlCut
            MsgBox "Please DO NOT Cut and Paste. Use Copy and Paste Special Values / Formula only.", vbCritical, "Cannot Use Cut & Paste"
            Application.CutCopyMode = False 'clear clipboard and cancel cut
        
        End Select
    
    End Sub
    

    To prevent Paste and replace with Paste Values (avoids overwriting formatting etc) I use this

     

    Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    
    'Routine to prevent normal/format paste and to replace with Paste Values/Formulas
    
    'can also prevent copying from a non excel application or separate session of Excel
    
    Dim UndoString As String
    
     'switch to ignore this code if in administrator mode
        If Range("swAdminMode").Value = "True" Then
        
            GoTo HandleExit
        
        End If    
        
    
    Application.ScreenUpdating = False
       
        
        'Undo all forms of Paste then re-paste values
            'Relies on capturing the 1st item on the Undo list in the Undo menu
            
            On Error Resume Next  ' required to deal with Undo list being empty
            
            UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1)
            
            'reset error check to 0 incase error did occur
            err = 0
            
            
            'if the action was not paste then this routine is exited
            If Left(UndoString, 5) <> "Paste" Then
                
                GoTo HandleExit
                
            End If
            
        
    'Rule
            
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            
            'MsgBox "Will now convert to values"
         
            'undo and convert to values
            Application.Undo
                   
            On Error Resume Next '- needed to avoid erroring out if data copied from different "instance" of excel
                
                Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                
                Application.CutCopyMode = False
                
                            
                'check if Paste Special caused an error - most likely by trying to copy from wrong session of Excel
                If err <> 0 Then
                
             
                    
                                
                    MsgBox "Are you trying to copy from a different session of Excel?" & Chr(13) & Chr(13) & _
                    "If so please close the file you are copying from " & Chr(13) & _
                    "and use the file open button on THIS session of Excel" & Chr(13) & _
                    "to open it and try again" & Chr(13) & Chr(13) & _
                    "The ability to copy from a non Excel application has been turned off." _
                    , vbOKOnly + vbQuestion, "Paste Failed"
            
                End If
                            
                            
            'reset error
            err = 0
        
    
    
    
    HandleExit:
    
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        
    
    End Sub
    

     

    I've had to take a few customisations out of the code above so hopefully haven't deleted anything critical

     

     

     

     

Resources