Protecting cells from Paste function on data input worksheet

[Yecart77]

Hi Everyone,

**Excel 2016**

I have a worksheet set up with some individual cells that people enter data in, then hit a Submit button that triggers a VBA Macro and transfers the data to another worksheet. This all works great.

My issue is in the cells above people copy and paste data from other sources and it seems to override the existing formatting in the cell.

Therefore I want to eliminate the ability to right click paste or Control + V and just have these cells available to type data in.

Worksheet is "Input" and the individual cells are for data entry are F11, F13, F15, F17. Protection / Locked is currently unchecked and the worksheet is password protected.

Does anyone have any insights for a VBA macro or some other functionality within Excel I can utilise to prevent the ability to paste?

I have Googled and tried several macros without success.

Thank you in advance for any suggestions.

Cheers,
Tracey

 

[number kruncher]

If you are only asking for users to enter data into 4 specific cells, you could untick the option 'Select unlocked cells' whilst protecting the workbook/sheet.

Hope this helps

 

[Jaafar Tribak]

@Yecart77

You could use the following workaround:

Add a new Class module to your vba project, give the module the name of CPaste and add the following code in it:

1- Class code (CPaste)

Option Explicit

Public Event OnPaste(ByVal Sh As Worksheet, ByVal Target As Range, ByRef Cancel As Boolean)
Private WithEvents CmndBrs As CommandBars

#If VBA7 Then
    Private Declare PtrSafe Function GetClipboardViewer Lib "user32" () As LongPtr
#Else
    Private Declare Function GetClipboardViewer Lib "user32" () As Long
#End If

Public Sub WatchPaste()
 Set CmndBrs = Application.CommandBars
End Sub

Private Sub CmndBrs_OnUpdate()
    #If Win64 Then
        Static i As LongPtr
    #Else
        Static i As Long
    #End If
    Dim bCancel As Boolean
    Dim oIntersect As Range
    
    If i <> GetClipboardViewer Then
        With Application
            If TypeName(.Selection) = "Range" Then
                RaiseEvent OnPaste(ActiveSheet, ActiveWindow.RangeSelection, bCancel)
                If bCancel Then
                    .EnableEvents = False  '<== Optional precaution.
                    .Undo
                    .EnableEvents = True
                    MsgBox "Pasting data in range: " & _
                            ActiveWindow.RangeSelection.Address & " is not allowed.", vbCritical
                End If
            End If
        End With
    End If
    i = GetClipboardViewer
End Sub

Private Sub Class_Terminate()
    Application.EnableEvents = True
    Set CmndBrs = Nothing
End Sub

2- Place the following code in the ThisWorkbook Module:

Option Explicit

Private WithEvents oCPaste As CPaste

Private Sub Workbook_Activate()
    Call AddPasteEvent
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call AddPasteEvent
End Sub

Private Sub AddPasteEvent()
    If oCPaste Is Nothing Then
        Set oCPaste = New CPaste
        oCPaste.WatchPaste
    End If
End Sub

' ______________________________ OnPaste Pseudo-Event Handler _____________________________

Private Sub oCPaste_OnPaste(ByVal Sh As Worksheet, ByVal Target As Range, Cancel As Boolean)
    Dim oIntersect As Range
    'Prevent pasting in range Sheet1.A1:D10
    If Sh Is Sheet1 Then
        Set oIntersect = Intersect(Target, Range("A1:D10"))
        If Not oIntersect Is Nothing Then
            Cancel = True
        End If
    End If
End Sub

The above OnPaste pseudo-event handler should now prevent the user from pasting data in Sheet1, Range A1:D10 ... Change target range to suit.

PS: You may also need to disable DragNdrop in the target worksheet to prevent the user from overriding the target cells with mouse dragging/moving.