Disable Cut, Copy, Paste Macro for One Column

[Ken Puls]

Reproduced from PM...

Hi Ken,

Can you please tell me how to use the Disable Cut, Copy, Paste Macro for one column only (column A)? This is for a template for other users and I need them to be able to copy and paste into the worksheet into other columns, except column A.

I would really appreciate the help. I have been struggling to find the answer for days for this.

Thank you very much!
Shannon

'*** In a standard module ***

Option Explicit 
 
Sub ToggleCutCopyAndPaste(Allow As Boolean) 
'Activate/deactivate cut, copy, paste and pastespecial menu items
Call EnableMenuItem(21, Allow) ' cut
Call EnableMenuItem(19, Allow) ' copy
Call EnableMenuItem(22, Allow) ' paste
Call EnableMenuItem(755, Allow) ' pastespecial
'Activate/deactivate drag and drop ability
Application.CellDragAndDrop = Allow 
'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application 
   Select Case Allow 
      Case Is = False 
         .OnKey "^c", "CutCopyPasteDisabled" 
         .OnKey "^v", "CutCopyPasteDisabled" 
         .OnKey "^x", "CutCopyPasteDisabled" 
         .OnKey "+{DEL}", "CutCopyPasteDisabled" 
         .OnKey "^{INSERT}", "CutCopyPasteDisabled" 
      Case Is = True 
         .OnKey "^c" 
         .OnKey "^v" 
         .OnKey "^x" 
         .OnKey "+{DEL}" 
         .OnKey "^{INSERT}" 
   End Select 
End With 
End Sub 
 
Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean) 
'Activate/Deactivate specific menu item
Dim cBar As CommandBar 
Dim cBarCtrl As CommandBarControl 
For Each cBar In Application.CommandBars 
   If cBar.Name <> "Clipboard" Then 
      Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True) 
      If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled 
   End If 
Next 
End Sub 
 
Sub CutCopyPasteDisabled() 
'Inform user that the functions have been disabled
MsgBox "Sorry! Cutting, copying and pasting have been disabled in this workbook!" 
End Sub

'*** In the ThisWorkbook Module ***

Option Explicit 
 
Private Sub Workbook_Activate() 
Call ToggleCutCopyAndPaste(False) 
End Sub 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
Call ToggleCutCopyAndPaste(True) 
End Sub 
 
Private Sub Workbook_Deactivate() 
Call ToggleCutCopyAndPaste(True) 
End Sub 
 
Private Sub Workbook_Open() 
Call ToggleCutCopyAndPaste(False) 
End Sub

(The code above comes from our KB)

Hi Shannon,

The code in the standard module that you reproduced above doesn't change, but the code in the ThisWorkbook module will. I've given you a couple of scenarios that could happen in the Worksheet_SelectionChange routine; the first is excepting the entire column A on Sheet 1, the second is excepting only a specific range on Sheet 2, the third is to leave all other sheets with cut/copy/paste still working.

'*** In the ThisWorkbook Module ***

Option Explicit

Private Sub Workbook_Activate()
'Force the current selection to be selected, triggering the appropriate
'state of the cut, copy & paste commands
    Selection.Select
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Re-enable the cut, copy & paste commands
    Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Deactivate()
'Re-enable the cut, copy & paste commands
    Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Open()
'Force the current selection to be selected, triggering the appropriate
'state of the cut, copy & paste commands
    Selection.Select
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Toggle the cut, copy & paste commands on selected ranges
Select Case Sh.Name
   Case Is = "Sheet1"
       'Disable cut, copy & paste for Sheet1, Column A
       If Not Intersect(Target, Target.Parent.Columns(1)) Is Nothing Then
          Call ToggleCutCopyAndPaste(False)
          Else
         Call ToggleCutCopyAndPaste(True)
      End If
   Case Is = "Sheet2"
      'Disable cut, copy & paste for Sheet2, Range G1:H5
      If Not Intersect(Target, Target.Parent.Range("G1:H5")) Is Nothing Then
         Call ToggleCutCopyAndPaste(False)
         Else
         Call ToggleCutCopyAndPaste(True)
      End If
      Case Else
         'Re-enable cut copy and paste commands as this is not a restricted sheet
         Call ToggleCutCopyAndPaste(True)
    End Select
End Sub

Hope this helps,