Excel VBA code to Force Values Only Paste causes s

Question

I've got a spreadsheet where users enter survey data and, like many have others, needed to prevent the users from overwriting various formatting features. I used the following:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Target.PasteSpecial xlPasteValues
Application.CutCopyMode = True
End Sub

The code works great for forcing values only paste after copying or cutting cells. When you cut or copy, the very next cell that you click on receives the paste, you don't have to use Ctrl+V or right click and select paste.

However, during testing it was discovered that if you cut or copy an object (shape, inserted picture, etc.) then it will continue pasting after the first mouse click. It will paste again and again with each subsequent click without stopping.

I verified this behavior in Excel 2010 and 2013.

Does anyone know how to modify this to correct the odd behavior when pasting objects?

Answer 1

If you want to allow only paste value method, just put the below code under the Microsoft Excel Objects ThisWorkbook (i.e. not under any module).

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim UndoString As String, srce As Range
    On Error GoTo err_handler
    UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1)
    If Left(UndoString, 5) <> "Paste" And UndoString <> "Auto Fill" Then
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Undo
    If UndoString = "Auto Fill" Then
        Set srce = Selection
        srce.Copy
        Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.SendKeys "{ESC}"
        Union(Target, srce).Select
    Else
        Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
err_handler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Note that though it'll work most of the times, it may well happen occasionally especially for external contents consisting features like wrap text, etc that nothing is copied.

That being said, the objective of preserving the format will still be maintained as it will force the user to try paste as value (or press F2 key and then Ctrl+V), instead of pasting directly.

Disclaimer: I don't take any credit for this code block as it's widely available in the internet.