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

holemania asked

on 2015-03-24

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

Comment

Watch Question

View Solution Only

Martin Liss"There is still no cure for the common birthday." ~John Glenn

Trusted Expert

Most Valuable Expert 2017

Distinguished Expert 2018

Commented: 2015-03-24

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

holemania

Author

Commented: 2015-03-27

Thank you that worked.