Restrict Specific cell in specific sheet to manual entries ONLY i.e. NO paste of any kind!

[Pobek]

Can someone please help with constructing a code that will enable me to restrict any form of pasting (ctrl V or right click) in a specific cell.

NOTE:
This cell is an access signIn area and as a result, the status bar disappears when you click on it (to avoid situations where onlookers can see the access code of different users during entry in the formula bar).

Is there a way that we can restrict this paste function without jeopardizing the existing formula-bar disappearing setting??

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Change the cell (in red) to suit you needs. Close the code window to return to your sheet.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("[COLOR="#FF0000"]A1[/COLOR]")) Is Nothing Then
        Application.CutCopyMode = False
    Else
        Application.CutCopyMode = True
    End If
End Sub

 

[Pobek]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Change the cell (in red) to suit you needs. Close the code window to return to your sheet.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("[COLOR=#FF0000]A1[/COLOR]")) Is Nothing Then
        Application.CutCopyMode = False
    Else
        Application.CutCopyMode = True
    End If
End Sub

Thanks,

But I already had this in there and it does not work:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
If Not Intersect(Target, Range("Tauthcod")) Is Nothing Then
Application.DisplayFormulaBar = False
Application.CutCopyMode = False
Else
Application.DisplayFormulaBar = True
Application.CutCopyMode = True
End If
End If
End Sub


Any suggestions ... ?

 

[mumps]

I tried this version using a specific cell (A1) instead of a named range ("Tauthcod") and it worked as you requested.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count = 1 Then
        If Not Intersect(Target, Range("[COLOR="#FF0000"]A1[/COLOR]")) Is Nothing Then
            Application.DisplayFormulaBar = False
            Application.CutCopyMode = False
        Else
            Application.DisplayFormulaBar = True
            Application.CutCopyMode = True
        End If
    End If
End Sub

 

[Pobek]

Very odd, just tried it again using I23 and still no show. I am copying the code from an email and pasting and its overwriting the cell. Really odd!

 

[mumps]

I just realized that the Application.CutCopyMode = False applies only to the "Application" which happens to be Excel so it doesn't apply to anything copied outside of Excel. After a little research, I found this work-around that seems to work. Place the following code in a standard module. This code basically empties the clipboard regardless of where the data is copied from.

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Place this macro in the code module for the worksheet and change the cell:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("[COLOR="#FF0000"]A1[/COLOR]")) Is Nothing Then
        OpenClipboard (0&)
        EmptyClipboard
        CloseClipboard
        Application.DisplayFormulaBar = False
        Application.CutCopyMode = False
    Else
        Application.DisplayFormulaBar = True
        Application.CutCopyMode = True
    End If
End Sub

 

[Pobek]

Very good! Nearly there!!

So this code stops any form of pasting which is good. However, if the cell (Tauthcode) iss already selected (prior to the copy)... it actually allows the paste. Tried forcing the command to go out and back into the tauthcode cell on the private function run but that only causes issues and errors.

Any addtional ideas

We nearly there ...

 

[mumps]

Delete the code you previously placed in the standard module and place these 2 macros in the worksheet code module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lastAction As String
    Application.ScreenUpdating = False
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
        If Left(lastAction, 5) = "Paste" Then
            Application.Undo
        End If
    End If
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Application.DisplayFormulaBar = False
    Else
        Application.DisplayFormulaBar = True
    End If
End Sub

 

[Pobek]

code falls over on this line ...


lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)

 

[mumps]

The macro worked properly for me when I tested it. I'm afraid I don't know why it's not working for you. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.