Excel - VBA disabled copy, paste, and cut with password

I need to prevent users from being able to copy, paste, cut, and drag/drop to my excel worksheet.  I found the code I need, but I also need to allow some people to be able to copy/paste.  Is it possible to integrate a password with the following?  Once password is enter, you can copy/paste, and then if you do again, you need to re-enter password?

Private Sub Workbook_Activate()
 Application.CutCopyMode = False
 Application.OnKey "^c", ""
 Application.CellDragAndDrop = False
 End Sub

 Private Sub Workbook_Deactivate()
 Application.CellDragAndDrop = True
 Application.OnKey "^c"
 Application.CutCopyMode = False
 End Sub

 Private Sub Workbook_WindowActivate(ByVal Wn As Window)
 Application.CutCopyMode = False
 Application.OnKey "^c", ""
 Application.CellDragAndDrop = False
 End Sub

 Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
 Application.CellDragAndDrop = True
 Application.OnKey "^c"
 Application.CutCopyMode = False
 End Sub

 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 Cancel = True
 MsgBox "Right click menu deactivated." & vbCrLf & _
 "Cannot copy or ''drag & drop''.", 16, "For this workbook:"
 End Sub

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 Application.CutCopyMode = False
 End Sub

 Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 Application.OnKey "^c", ""
 Application.CellDragAndDrop = False
 Application.CutCopyMode = False
 End Sub

 Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
 Application.CutCopyMode = False
 End Sub

Open in new window

holemaniaAsked:
Who is Participating?
 
Martin LissOlder than dirtCommented:
Put a password value for allowing copy/paste in cell A1 of sheet2. Then hide the first row of that sheet and password protect the sheet. Then change the Workbook_SheetBeforeRightClick code (and any other event where it's needed) to

 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 Dim strPassword As String
 
 strPassword = InputBox("Please enter the copy/drag/drop password")
 If strPassword = Sheets("Sheet2").Range("A1") Then
    Exit Sub
 End If

 Cancel = True
 MsgBox "Right click menu deactivated." & vbCrLf & _
 "Cannot copy or ''drag & drop''.", 16, "For this workbook:"
 End Sub

Open in new window

0
 
holemaniaAuthor Commented:
Thank you that worked.
0
 
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.

Advertise Here