Disable Cut, Copy, Paste Macro for One Column
Reproduced from PM...
Quote:
Originally Posted by fluteloop_19
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 ***
Code:
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 ***
Code:
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 ***
Code:
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,
How to Disable cut, copy & paste for multiple cells?
I have used the code above and tweaked it to work for my workbook. However how do you disable cut, copy & paste for multiple cells?
In the code mentioned above it mentions:
Code:
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)
But how do I disable Cell (A2,D21,C47, C62:F62,.....)
Please PLEASE help if you can.
Regards,
K
:doh:: pray2::banghead:
Disable Cut, Copy, Paste Macro for selected cell ranges
Hi,
I’ve been searching for a solution on disabling cut/paste/copy functions in selected cell ranges rather than the entire worksheet. I couldn't find a really suitable solution until I found the very useful bit of code included in this post. For this I am really grateful.
As you will see pasted below, I’ve made some very minor modifications to allow a single column to have all the functions and I blocked a certain cell range.
It works perfectly, except for one small thing. I can’t figure out if I did something wrong to cause it, or if something changed in Excel 2003 (I’m on Sp3) since this original post was made.
The cell range I’ve blocked from using cut/copy/paste successfully blocks cut/copy/paste from right clicks, cut and copy on the toolbar, but the paste button on the toolbar is still visible.
Can anyone please point me in the right direction?
Code:
*** In the ThisWorkbook 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
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 = "Contracting Activity"
'Disable cut, copy & paste for Contracting Activity, Range D20:AD325
If Not Intersect(Target, Target.Parent.Range("D20:AD325")) Is Nothing Then
Call ToggleCutCopyAndPaste(False)
Else
Call ToggleCutCopyAndPaste(True)
End If
Case Is = "Planned Activity"
'Disable cut, copy & paste for Planned Activity, Range D20:AD325
If Not Intersect(Target, Target.Parent.Range("D20:AD325")) 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
Enable the "Disable Cut, Copy, Paste" macro code
Hi Ken,
I am a newbie at VBA.
I had a public seminar presentation to do for which I used the code you had uploaded Disable Cut, Copy, Paste.
However now that my presentation has been done, I need to enable the cut copy paste functions on my workbook. HOW DO I DO THAT? I deleted the macro and saved the file but it still does not work. PLEASE HELP:friends:
Enabling the "Disable Cut, Copy, Paste" macro
Hi Ken,
I am a newbie at VBA.
I had a public seminar presentation to do for which I used the code you had uploaded Disable Cut, Copy, Paste.
However now that my presentation has been done, I need to enable the cut copy paste functions on my workbook. HOW DO I DO THAT? I deleted the macro and saved the file but it still does not work. PLEASE HELP:friends:
Solved: Improved Disable Cut,Copy,Paste for specified range
I know this is an old thread, but seeing that it shows up on Google's page 1 when searching for vba code to disable cut, copy and paste for a specified range and this was the most complete code I've ran across to do the task, I felt it appropriate to update this with a better version.
Bugs found in Ken's version when running under XL03 and WinXP Sp3:
1. Will allow a paste into restricted cells if a restricted cell is already selected and you are copying from a different sheet.
Fix: Add code to check the currently selected cell when you change worksheets.
2. Visa Versa of the above, if a restricted cell is selected and you need to paste something in another sheet. Say from an external source, when you switch to the other sheet, it is still disabled until you change cells.
Fix: Same as above. Checking currently selected cell when you change worksheets.
3. Probably the most important. At least under my system configuration, with drag and drop being disabled on selection change, it will deselect whatever has been copied, thus completely defeating the purpose of being able to copy and paste within cells outside of the restricted range.
Fix: Moved Disabling drag and drop to encompass the entire workbook. This may or may not be an issue for some, but it is the best I could come up with for now to ensure the cut, copy and paste restrictions work as intended.
4. The original use of Selection.Select would not trigger the code to check if the selected range is within the restricted range.
Fix: Switch to calling a sub that will check the activecell against the restricted range.
Additional Code Change information:
The actual checking of all ranges has moved to a sub called ChkSelection and added a function called InRange to use to check if the selected cell is within the range that is restricted.
The following is a modified version of Ken's original Disable Cut,Copy,Paste code....
Place the follow code into ThisWorkbook
Code:
Option Explicit
Private Sub Workbook_Activate()
'Force the current selection to be selected, triggering the appropriate
'state of the cut, copy & paste commands
Call ChkSelection(ActiveSheet)
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Re-enable the cut, copy & paste commands
Call ToggleCutCopyAndPaste(True)
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Deactivate()
'Re-enable the cut, copy & paste commands
Call ToggleCutCopyAndPaste(True)
Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_Open()
'Force the current selection to be selected, triggering the appropriate
'state of the cut, copy & paste commands
Call ChkSelection(ActiveSheet)
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call ChkSelection(Sh)
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Toggle the cut, copy & paste commands on selected ranges
Call ChkSelection(Sh)
End Sub
Place the following code into its own standard module:
Code:
Option Explicit
Public Function InRange(Range1 As Range, Range2 As Range) As Boolean
' Added function to check if Cell is In Range
' returns True if Range1 is within Range2'
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function
Sub ChkSelection(ByVal Sh As Object)
'Added Primarily to have one place to set restrictions
'It also fixes the issue where a cell you don't want to
'copy/paste from/to is already selected, but you
'came from a sheet that wasn't protected.
Dim rng As Range
Set rng = Range(Selection.Address)
Select Case Sh.Name
Case Is = "Sheet1"
'Disable copy and paste for anything in column A
If InRange(rng, Columns("A")) Then
Call ToggleCutCopyAndPaste(False)
Else
Call ToggleCutCopyAndPaste(True)
End If
Case Is = "Sheet2"
'Disable copy and paste for anything in range G1 to G20
If InRange(rng, Range("G1:G20")) Then
Call ToggleCutCopyAndPaste(False)
Else
Call ToggleCutCopyAndPaste(True)
End If
Case Else
Call ToggleCutCopyAndPaste(True)
End Select
End Sub
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
'Drag and Drop Disabled from Original code due to deselecting what has been
'copied and not allowing paste. Moved to when workbook opens.
'Drag and drop will not be allowed for entire workbook.
'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 for the specified range."
End Sub
Enjoy and again, sorry for resurrecting an old thread, but like I said, it is the best I've ran across and shows up on Google's page 1, so I thought I would update it with something that functions a bit better for anyone else who runs across this thread.