Catching Paste Operations

Introduction

You know the situation: You have carefully setup a workbook with intricate Validation schemes. But then along comes your user and he copies and pastes at will. Result: Validation zapped, workbook structure violated.

What to do? The only way I find reliable is to catch all possible paste operations. But this isn't very easy, since there are a zilion ways to paste:

Control+v
Control+Insert
Shift + Insert
Enter
And of course various menu items and toolbar buttons, which may be located anywhere.

This article shows one way to intercept all these paste operations.

NB: as it is now, the article focuses on Excel 2000 to 2003. I will add the needed steps for Excel 2007 later on.

Explanation Of Parts Of The Code

Catching Keyboard Shortcuts

The only way to catch paste keyboard shortcuts is by assigning them to your own paste code. E.g. like this:

    Application.OnKey "^v", "MyPasteValues"
    Application.OnKey "^{Insert}", "MyPasteValues"
    Application.OnKey "+{Insert}", "MyPasteValues"
    Application.OnKey "~", "MyPasteValues"
    Application.OnKey "{Enter}", "MyPasteValues"

(the MyPasteValues routine is shown further below)

Catching Clicks On Toolbar And Menu Controls

To catch clicks on Commandbar controls, I used a class module in which a variable is declared of type commandbarcontrol, using the WithEvents keyword. Then an instance of this class module is created for each control I want to intercept.

The class (named clsCommandBarCatcher), contains this code:

'-------------------------------------------------------------------------
' Module    : clsCommandBarCatcher
' Company   : JKP Application Development Services (c)
' Author    : Jan Karel Pieterse
' Created   : 4-10-2007
' Purpose   : This class catches clicks on Excel's commandbars to be able to prevent pasting.
'-------------------------------------------------------------------------
Option Explicit

Public WithEvents oComBarCtl As Office.CommandBarButton

Private Sub Class_Terminate()
    Set oComBarCtl = Nothing
End Sub

Private Sub oComBarCtl_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    CancelDefault = True
    Application.OnTime Now, "MyPasteValues"
End Sub

And the code to create an instance of this class could look like this:

    Dim oCtl As CommandBarButton
    Dim CCatcher As clsCommandBarCatcher
    Set oCtl = Application.CommandBars("Cell").FindControl(ID:=3185, recursive:=True)
    Set CCatcher = New clsCommandBarCatcher
    Set CCatcher.oComBarCtl = oCtl

To keep the instances of the classes "alive" I create a (module) collection variable and add each instance to the collection.

The paste is handled by this routine:

Public Sub MyPasteValues()
'-------------------------------------------------------------------------
' Procedure : EnableDisableControl
' Author    : Jan Karel Pieterse www.jkp-ads.com
' Created   : 24-9-2007
' Purpose   : Propriatary paste values routine called from control event
'             handler in clsCommandBarCatcher and from various OnKey macros.
'-------------------------------------------------------------------------
    If Application.CutCopyMode <> False Then
        If MsgBox("Normal paste operation has been disabled. You are about to Paste Values (cannot be undone), proceed?" & vbNewLine & "Tip: to be able to undo a paste, use the paste values button on the toolbar.", vbQuestion + vbOKCancel, GSAPPNAME) = vbOK Then
            On Error Resume Next
            Selection.PasteSpecial Paste:=xlValues
            IsCellValidationOK Selection
        End If
    ElseIf Application.MoveAfterReturn Then
        On Error Resume Next
        Select Case Application.MoveAfterReturnDirection
        Case xlUp
            ActiveCell.Offset(-1).Select
        Case xlDown
            ActiveCell.Offset(1).Select
        Case xlToRight
            ActiveCell.Offset(, 1).Select
        Case xlToLeft
            ActiveCell.Offset(, -1).Select
        End Select
    End If
End Sub

Note that the code above also mimicks the MoveAfterReturn behaviour of Excel.

Catching clicks on the Excel 2007 and 2010 Ribbon

To catch clicks on the various Excel 2007 and 2010 paste controls, you have to include CustomUI with your Excel 2007/2010 format xlsm file. The relevant Ribbon XML code is listed here:

This page by Ron de Bruin clearly explains how to add ribbon customisations to your files

Cell Drag And Drop Mode

Dragging the fill handle is another way to wreck your validation. Hence this is turned off too. Unfortunately changing this setting empties the clipboard, so this setting cannot be toggled at will when switching workbooks. If you do turn it on and off when switching to and from your workbook, copying and pasting from another workbook to the one with the code becomes impossible.

Validation

The code I showed above redirects all paste operations to one routine, which does a paste special, values. But pasting does not trigger any validation checks. Also, there is no way of knowing what cells may be affected by the paste before the actual paste has been done. Luckily, after the paste, the Selection object is equal to the cells affected by the paste. Using the "Validation" object of the Range object it is possible to check whether the cells adhere to their validation settings. I created this function, to which I pass the range that has been changed. The function returns False as soon as any cell violates its validation rule:

Public Function IsCellValidationOK(oRange As Object) As Boolean
'-------------------------------------------------------------------------
' Procedure : ValidateCells
' Author    : Jan Karel Pieterse www.jkp-ads.com
' Created   : 21-11-2007
' Purpose   : This routine checks if entries pasted into the cells in oRange
'             are not violating a validation rule.
'             Returns False if any cell's validation is violated
'-------------------------------------------------------------------------
    Dim oCell As Range
    If TypeName(oRange) <> "Range" Then Exit Function
    IsCellValidationOK = True
    For Each oCell In oRange
        If Not oCell.Validation Is Nothing Then
            If oCell.HasFormula Then
            Else
                If oCell.Validation.Value = False Then
                    IsCellValidationOK = False
                    Exit For
                End If
            End If
        End If
    Next
    If IsCellValidationOK = False Then
        MsgBox "Warning!!!" & vbNewLine & vbNewLine & _
            "The paste operation has caused illegal entries to appear" & vbNewLine & _
            "in one or more cells containing validation rules." & vbNewLine & vbNewLine & _
            "Please check all cells you have just pasted " & vbNewLine & _
            "into and correct any errors!", vbOKOnly + vbExclamation, GSAPPNAME
        oRange.Select
    End If
End Function

Switching On And Off

Of course I want this paste restriction to work on just the workbook with the code. This means some code in the ThisWorkbook module is needed, to be precise in the Workbook_DeActivate and Workbook_Activate events. This is all code I have in ThisWorkbook:

Option Explicit

'Holds time of scheduled ontime macro
'(Workbook_Before_Close and Workbook_Deactivate)
Private mdNextTimeCatchPaste As Double

Private Sub Workbook_Activate()
    CatchPaste
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopCatchPaste
    mdNextTimeCatchPaste = Now
    Application.OnTime mdNextTimeCatchPaste, "'" & ThisWorkbook.Name & "'!CatchPaste"
    Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Deactivate()
    StopCatchPaste
    On Error Resume Next
    'Cancel scheduled macro's,
    'because we might be closing the file
    Application.OnTime mdNextTimeCatchPaste, "'" & ThisWorkbook.Name & "'!CatchPaste", , False
End Sub

Private Sub Workbook_Open()
    CatchPaste
End Sub

Putting It All Together

The entire module that handles the initialisation and processes the paste operation looks like this:

'-------------------------------------------------------------------------
' Module    : modHandlePaste
' Author    : Jan Karel Pieterse
' Created   : 24-9-2007
' Purpose   : Module that ensures paste and paste formats is disabled
'-------------------------------------------------------------------------
Option Explicit
Option Private Module

Dim mcCatchers As Collection

Sub CatchPaste()
'-------------------------------------------------------------------------
' Procedure : CatchPaste
' Author    : Jan Karel Pieterse www.jkp-ads.com
' Created   : 24-9-2007
' Purpose   : This routine ensures all paste operations are redirected to our own.
'             This way we avoid overwriting styles and validations.
'-------------------------------------------------------------------------
    StopCatchPaste
    Set mcCatchers = New Collection
    'Paste button
    AddCatch "Dummy", 22
    'Paste button (with dropdown)
    EnableDisableControl 6002, False
    'Paste Special button
    AddCatch "Dummy", 755
    'Paste As Hyperlink button
    AddCatch "Dummy", 2787
    'Paste Formats bottun
    AddCatch "Dummy", 369
    'Insert Cut cells button
    AddCatch "Dummy", 3185
    'Insert Copied Cells button
    AddCatch "Dummy", 3187
    Application.OnKey "^v", "MyPasteValues"
    Application.OnKey "^{Insert}", "MyPasteValues"
    Application.OnKey "+{Insert}", "MyPasteValues"
    Application.OnKey "~", "MyPasteValues"
    Application.OnKey "{Enter}", "MyPasteValues"

    'Changing the celldragdrop mode clears the clipboard.
    'This means if you switch from another workbook back to this one, you would be unable to copy
    'information and paste it into the template. This is why we do not reinstate the
    'celldragdropmode when switching away from a B1 template and vice versa: switch it off
    'when we return to a template.
    If Application.CellDragAndDrop Then
        'If the user has manually changed this mode to true, the clipboard WILL be emptied due to the next line
        Application.CellDragAndDrop = False
    End If
End Sub

Sub StopCatchPaste()
'-------------------------------------------------------------------------
' Procedure : StopCatchPaste
' Author    : Jan Karel Pieterse www.jkp-ads.com
' Created   : 24-9-2007
' Purpose   : Resets the paste operations to their defaults
'-------------------------------------------------------------------------

    Dim lCount As Long
    On Error Resume Next
    Set mcCatchers = Nothing
    EnableDisableControl 6002, True
    Application.OnKey "^v"
    Application.OnKey "^{Insert}"
    Application.OnKey "+{Insert}"
    Application.OnKey "~"
    Application.OnKey "{Enter}"
    'Changing the celldragdrop mode clears the clipboard.
    'This means if you switch from another workbook back to this one, you would be unable to copy
    'information and paste it into the template. This is why we do not reinstate the
    'celldragdropmode when switching away from a B1 template and vice versa: switch it off
    'when we return to a template.
    'Next line disabled for this reason!!!
'    Application.CellDragAndDrop = True
End Sub

Sub AddCatch(sCombarName As String, lID As Long)
'-------------------------------------------------------------------------
' Procedure : AddCatch
' Author    : Jan Karel Pieterse www.jkp-ads.com
' Created   : 24-9-2007
' Purpose   : Adds a commandbarcontrol to be monitored
'-------------------------------------------------------------------------
    Dim oCtl As CommandBarControl
    Dim CCatcher As clsCommandBarCatcher
    Dim oBar As CommandBar
    Set oCtl = Nothing
    On Error Resume Next
    Set oBar = Application.CommandBars(sCombarName)
    If oBar Is Nothing Then
        Set oBar = Application.CommandBars.Add(sCombarName, , , True)
        oBar.Controls.Add ID:=lID
        oBar.Visible = True
    End If
    With oBar
        Set oCtl = .FindControl(ID:=lID, recursive:=True)
        If oCtl Is Nothing Then
            Set oCtl = .Controls.Add(ID:=lID)
        End If
    End With
    'Try Insert copied/cut cells separately through the cells shortcut menu
    If oCtl Is Nothing And (lID = 3185 Or lID = 3187) Then
        Set oCtl = Application.CommandBars("Cell").FindControl(ID:=lID, recursive:=True)
    End If
    Set CCatcher = New clsCommandBarCatcher
    Set CCatcher.oComBarCtl = oCtl
    mcCatchers.Add CCatcher
    Set CCatcher = Nothing
    oBar.Delete
    Set oBar = Nothing
End Sub

Private Sub EnableDisableControl(lID As Long, bEnable As Boolean)
'-------------------------------------------------------------------------
' Procedure : EnableDisableControl
' Author    : Jan Karel Pieterse www.jkp-ads.com
' Created   : 24-9-2007
' Purpose   : Enables or disables a specific control on all commandbars
'-------------------------------------------------------------------------

    Dim oBar As CommandBar
    Dim oCtl As CommandBarControl
    On Error Resume Next
    For Each oBar In CommandBars
        Set oCtl = oBar.FindControl(ID:=lID, recursive:=True)
        If Not oCtl Is Nothing Then
            oCtl.Enabled = bEnable
        End If
    Next
End Sub

Public Sub MyPasteValues()
'-------------------------------------------------------------------------
' Procedure : EnableDisableControl
' Author    : Jan Karel Pieterse www.jkp-ads.com
' Created   : 24-9-2007
' Purpose   : Propriatary paste values routine called from control event
'             handler in clsCommandBarCatcher and from various OnKey macros.
'-------------------------------------------------------------------------
    If Application.CutCopyMode <> False Then
        If MsgBox("Normal paste operation has been disabled. You are about to Paste Values (cannot be undone), proceed?" & vbNewLine & "Tip: to be able to undo a paste, use the paste values button on the toolbar.", vbQuestion + vbOKCancel, GSAPPNAME) = vbOK Then
            On Error Resume Next
            Selection.PasteSpecial Paste:=xlValues
            IsCellValidationOK Selection
        End If
    ElseIf Application.MoveAfterReturn Then
        On Error Resume Next
        Select Case Application.MoveAfterReturnDirection
        Case xlUp
            ActiveCell.Offset(-1).Select
        Case xlDown
            ActiveCell.Offset(1).Select
        Case xlToRight
            ActiveCell.Offset(, 1).Select
        Case xlToLeft
            ActiveCell.Offset(, -1).Select
        End Select
    End If
End Sub

Public Function IsCellValidationOK(oRange As Object) As Boolean
'-------------------------------------------------------------------------
' Procedure : ValidateCells
' Author    : Jan Karel Pieterse www.jkp-ads.com
' Created   : 21-11-2007
' Purpose   : This routine checks if entries pasted into the cells in oRange
'             are not violating a validation rule.
'             Returns False if any cell's validation is violated
'-------------------------------------------------------------------------
    Dim oCell As Range
    If TypeName(oRange) <> "Range" Then Exit Function
    IsCellValidationOK = True
    For Each oCell In oRange
        If Not oCell.Validation Is Nothing Then
            If oCell.HasFormula Then
            Else
                If oCell.Validation.Value = False Then
                    IsCellValidationOK = False
                    Exit For
                End If
            End If
        End If
    Next
    If IsCellValidationOK = False Then
        MsgBox "Warning!!!" & vbNewLine & vbNewLine & _
            "The paste operation has caused illegal entries to appear" & vbNewLine & _
            "in one or more cells containing validation rules." & vbNewLine & vbNewLine & _
            "Please check all cells you have just pasted " & vbNewLine & _
            "into and correct any errors!", vbOKOnly + vbExclamation, GSAPPNAME
        oRange.Select
    End If
End Function

Sample File

I prepared a sample file so you can see how to put this all together. The download contains two workbooks; one for Excel 2003 and earlier, the other for Excel 2007 and 2010.

Comments

Showing last 8 comments of 95 in total (Show All Comments):

Comment by: Jason (9/28/2011 3:18:08 PM)

you touched briefly on the drag and drop being disabled above. I'm trying to catch the "drop event" which I believe is the

.cut Destination:= somerange

in the Worksheet_Change(ByVal Target As Excel.Range) but the cutcopymode status does not have the 'xlcut' value.
I want to do something like this:
if cells are edited or changed do nothing
if cells are draged and dropped then
test for cells in the Target range having validation
if true then application.undo
if false do nothing

I can do this in a single cell, but have trouble in ranges
I've played around with the code below butit always fails in one way or the other:

Worksheet_Change(ByVal Target As Excel.Range)
If Application.CutCopyMode = True Then
Dim CVal As Integer
For Each Wscell In Selection.Cells
On Error Resume Next
CVal = Wscell.Validation.Type
If CVal > 0 and Cutcopymode=xlcut Then
Application.EnableEvents = False
Application.Undo
On Error GoTo 0
GoTo ExitSub
End If
Next
End If

Comment by: Jan Karel Pieterse (9/28/2011 11:26:53 PM)

HI Yingxi,

Thanks!

Comment by: Jan Karel Pieterse (9/28/2011 11:39:28 PM)

Hi Jason,

In order to detect whether the user has cut something, you have to first undo that operation. CUmbersome, because if you want to allow the operation afterwards, you'll somehow have to redo the operation if all is well. This appears to work, but not for dragging a range with the mouse:

Option Explicit

Dim mbNoEvent As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    If mbNoEvent Then Exit Sub
    mbNoEvent = True
    Application.Undo
    If Application.CutCopyMode = xlCopy Then
        Application.Undo
    ElseIf Application.CutCopyMode = False Then
        Application.Undo
    Else
        MsgBox "Cutting and pasting is not allowed!"
    End If
    mbNoEvent = False
End Sub

Comment by: Jason (10/4/2011 11:12:16 AM)

Jan, thanks' again for your quick response. you got me pointed in the right direction with the application.undo and then testing the ranges. I did find a solution to testing a DragandDrop event:
The cell fill color and pattern are reset to none (16777215 for colr and xlnone for pattern) simply filling the cells with White and a border (only to define each cell) allows to test for a change in the color/pattern values when the cells are dragged and dropped. I have cells that I want to test for validation (any test could be done),so I undo the move (your idea) and then test the source (Target) and destination (Selection) ranges for validation. if there is validation I keep the undo. if there's not validation I undo the undo and keep the DragandDrop. then I reformat the Target cells (the reformatting is not included here as I use another Procedure to do this as I have some custom formatting). I use the worksheet_change event to trap the Drag and Drop. I found it useful to set the ranges (source and destination) to string variables instead of Range variables as the Selection Range changes in certain cases. I also trap a copy/ paste event (your idea). this works on both single and multiple cell ranges. I self taught VBA so often times my code is not as elegant as it could be and I do not use hungarian notation for my variables in this case. Hopefully this will be useful to someone trying to trap a DragandDrop event. Thanks' again for getting me pointed in the right direction!
see next post for code

Comment by: Jason (10/4/2011 11:12:53 AM)

Public WsCHTarget As String
Public WsCHSelection As String
Public CMTSCopyMode As Boolean

Public Sub Worksheet_Change(ByVal Target As Excel.Range)
CMTSCopyMode = False
If Application.CutCopyMode = xlCopy Then CMTSCopyMode = True
WsCHTarget = Target.Address
WsCHSelection = Selection.Address

Application.EnableEvents = False:Application.ScreenUpdating = False

CheckValidation

Application.EnableEvents = True: Application.ScreenUpdating = True ': Application.CutCopyMode = False

End Sub

Public Sub CheckValidation()

If CMTSCopyMode = True Then GoTo BeginTest
If Range(WsCHTarget).Interior.Pattern = xlNone And Range(WsCHTarget).Interior.Color = 16777215 Then GoTo BeginTest
GoTo ExitSub
''''''''begin test for moved or overwritten validation cells''''''''
BeginTest:
Dim CVal As Integer, WsCell As Range
Application.EnableEvents = False: Application.ScreenUpdating = False: ActiveSheet.Unprotect
On Error Resume Next
Application.Undo
''''''''test target begin range''''''''
For Each WsCell In Range(WsCHTarget).Cells
On Error Resume Next
CVal = WsCell.Validation.Type
If CVal > 0 Then
GoTo ExitSub
End If
Next
''''''''test selection destination range''''''''
For Each WsCell In Range(WsCHSelection).Cells
On Error Resume Next
CVal = WsCell.Validation.Type
If CVal > 0 Then
GoTo ExitSub
End If
Next
''''''''no validation cells - found redo the undo
On Error Resume Next
Application.Undo
''''''''
ExitSub:
Application.CutCopyMode = False
ActiveSheet.Protect
End Sub

Comment by: Jan Karel Pieterse (10/5/2011 12:09:01 AM)

Hi Jason,

Thanks for the code.
There is no need to worry about not using Hungarian variable names notation. However, I'm no fan of using Goto's in code except for the On Error Goto statement.
I think your code can be rewritten to:

Public Sub CheckValidation()
    Dim CVal As Integer
    Dim WsCell As Range
    Dim bStop As Boolean
    If CMTSCopyMode = True Or _
     (Range(WsCHTarget).Interior.Pattern = xlNone _
        And Range(WsCHTarget).Interior.Color = 16777215) Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
        On Error Resume Next
        Application.Undo
        ''''''''test target begin range''''''''
        For Each WsCell In Range(WsCHTarget).Cells
            On Error Resume Next
            CVal = WsCell.Validation.Type
            If CVal > 0 Then
                bStop = True
            End If
        Next
        If bStop = False Then
            ''''''''test selection destination range''''''''
            For Each WsCell In Range(WsCHSelection).Cells
                On Error Resume Next
                CVal = WsCell.Validation.Type
                If CVal > 0 Then
                    bStop = True
                End If
            Next
            ''''''''no validation cells - found redo the undo
            If bStop = False Then
                On Error Resume Next
                Application.Undo
            End If
        End If
    End If     ''''''''
    Application.CutCopyMode = False
    ActiveSheet.Protect
End Sub

Comment by: xoan.ninguen (1/10/2012 1:05:47 PM)

Hy Jan,

I experienced the following when playing this macro (using XL2003 on WinXP SP3):
- It seems to be very busy on opening Excel File (even with the original downloaded file).
- After a crash I could not recover all functions.

I must confess (for what is the last point mentioned) that I've playing a lot with this and that, and I made a few changes to your macro, more specifically on CatchPaste procedure, adding dummy dissabling controls for ID:19 (copy), 21 (Cut), 478 (Delete), 847 (DeleteSheet), 296 (insertRow), 297 (insertRow),...

Ok that is not the point. I could near restore all these but for 847, 296 and 297 (don't know why these can't), I would rather reinstall XL that continue testing (although fun).

What I came here for is to explain that I could achieve dissabling all these without the class. I can get to open that file with macro with no delay (as usual in XL).
I tried to append the code used but its 10105 characters long... :(

Will Email you...

Comment by: Jan Karel Pieterse (1/11/2012 7:38:21 AM)

Hi Xaon,

Thanks for your comments. If your current code does what you need, then of course my suggested method is overkill.

What the method shown here does do however is instead of disabling all those controls, redirecting them to my macro. Your solution seems to only disable most controls and redirect just the shortcut keys.

Have a question, comment or suggestion? Then please use this form.

If your question is not directly related to this web page, but rather a more general "How do I do this" Excel question, then I advise you to ask your question here: www.eileenslounge.com.