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,

[Quick?]

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:

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:

[rfettig91214]

The original disable cut copy paste disable worked in office 2003---but--doesnt seem to work in office 2007 as i can use the copy and paste in the ribbon- and the clipboard internal to the workbook (ie copy then paste to a second page) --or when opening another workbook---copying pasting from the clipboard. is there a way to disable the clipboard entirely?

[PcKid888]

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?


*** 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

[guigui]

Hi Everybody,
Beginer in macros and VBA, I'm very glad to find what I look for since many days....
My need is a little bit different : I would like to "Disable Cut, Copy, Paste" for all the sheets, except a specific range in 2 different sheets....
I've tried to modify the above codes, but it does not work.
Help Please.

[sachin19831]

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:

[sachin19831]

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:

[Peixe]

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



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:


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.

[SamT]

Peixe,

Thank you very much. I am definately saving this web page in my snippets library.

SamT

[snb]

This might suffice as well; all the code in the workbook codemodule.



Private Sub Workbook_Activate()
ChkSelection ActiveSheet
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ToggleCutCopyAndPaste True
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Deactivate()
ToggleCutCopyAndPaste True
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Open()
ChkSelection ActiveSheet
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ChkSelection Sh
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ChkSelection Sh
End Sub

Sub ChkSelection(ByVal Sh As Object)
Select Case Sh.Name
Case "Sheet1"
ToggleCutCopyAndPaste Intersect(Selection, sh.Columns(1)) Is Nothing
Case "Sheet2"
ToggleCutCopyAndPaste Not Intersect(Selection, sh.range("G1:G20")) Is Nothing
Case Else
ToggleCutCopyAndPaste True
End Select
End Sub

Sub ToggleCutCopyAndPaste(v_true As Boolean)
EnableMenuItem Array(19, 21, 22, 75), v_true
For j = 1 To 5
If v_true Then Application.OnKey Choose(j,"^c", "^v", "^x", "+{DEL}", "^{INSERT}")
If Not v_true Then Application.OnKey Choose(j,"^c", "^v", "^x", "+{DEL}", "^{INSERT}"), "CutCopyPasteDisabled"
Next
End Sub

Sub EnableMenuItem(ctlId, v_Enabled As Boolean)
On Error Resume Next
For Each cb In Application.CommandBars
If cb.Name <> "Clipboard" Then
For Each it In ctlId
cb.FindControl(, it).Enabled = v_Enabled
Next
End If
Next
End Sub

Sub CutCopyPasteDisabled()
MsgBox "Sorry! Cutting, copying and pasting have been disabled for the specified range."
End Sub

[Peixe]

Good job SNB. Looks cleaner for sure. I'm not sure if there would be some unforeseen side effects of moving the subs to ThisWorkbook or not.

Although, I did see a minor bug that both of us missed.



Private Sub Workbook_Activate()
ChkSelection ActiveSheet
Application.CellDragAndDrop = True
End Sub
Should actually read....


Private Sub Workbook_Activate()
ChkSelection ActiveSheet
Application.CellDragAndDrop = False
End Sub

With the intent of turning off drag on drop for this workbook, but when switching back and forth between other workbooks, it would turn on and off. As is you could still slip one through if you opened another workbook, then came back to this one.

[snb]

I won't comment on that one. :)

[fyrigoyeno]

Please, the macro works perfect, but I need to activate it in one sheet for 2 columns, like this:


Sub ChkSelection(ByVal Sh As Object)
Select Case Sh.Name
Case "CLIENTE PN"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(15)) Is Nothing
Case "CLIENTE PJ"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
Case "CONCESIONARIOS"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(10)) Is Nothing
Case "PROVEEDORES"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
Case "PROVEEDORES"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
Case "EMPLEADOS"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(16)) Is Nothing
Case Else
ToggleCutCopyAndPaste True
End Select
End Sub

In sheet "PROVEEDORES" only detects the 13th column, but not the 17th column, the rest of the code works, with one exception:

In Excel 2013 the macro


Sub CutCopyPasteDisabled()
MsgBox ("Lo sentimos, la fecha no puede ser copiada de otra celda")
End Sub

Only runs on a standard module, not in the Thisworkbook module
Thanks

[SamT]

fyrigoyeno (http://www.vbaexpress.com/forum/member.php?u=49936),

This might work


Case "PROVEEDORES"
If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
End If

[fyrigoyeno]

SamT:

Thanks for the lightspeed response, your code works perfect :clap2:

And thanks to all the rest of you guys, a perfect solution for controling things in a sheet.

Fyrigoyeno (newbie)

[fyrigoyeno]

I just notice that when the macro runs at least one time and then I attemp to close the file I am getting this error:

Error 1004
Error in method "Intersect" on object "Global"
(sorry I dont know how to insert a image from url)
This is the line with the error:

Case "PROVEEDORES"
If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
End If

The error comes up each time the macro runs, for example, If I run the macro on Sheet1, the error is present in the line of that sheet. If I run the macro on several Sheets, the error comes in the last sheet used when closing the file
Help on this please, here is my entire code:

This workbook module:


Private Sub Workbook_Activate()
ChkSelection ActiveSheet
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ToggleCutCopyAndPaste True
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Deactivate()
ToggleCutCopyAndPaste True
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Open()
ChkSelection ActiveSheet
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ChkSelection Sh
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ChkSelection Sh
End Sub

Sub ChkSelection(ByVal Sh As Object)
Select Case Sh.Name
Case "CLIENTE PN"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(15)) Is Nothing
Case "CLIENTE PJ"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
Case "CONCESIONARIOS"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(10)) Is Nothing
Case "PROVEEDORES"
If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
End If
Case "EMPLEADOS"
If Not Intersect(Selection, Sh.Columns(12)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(12)) Is Nothing
ElseIf Not Intersect(Selection, Sh.Columns(16)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(16)) Is Nothing
End If
Case Else
ToggleCutCopyAndPaste True
End Select
End Sub

Sub ToggleCutCopyAndPaste(v_true As Boolean)
EnableMenuItem Array(19, 21, 22, 755), v_true
For k = 1 To 6
If v_true Then Application.OnKey Choose(k, "^c", "^j", "^v", "^x", "+{DEL}", "^{INSERT}")
If Not v_true Then Application.OnKey Choose(k, "^c", "^j", "^v", "^x", "+{DEL}", "^{INSERT}"), "CutCopyPasteDisabled"
Next
End Sub

Sub EnableMenuItem(ctlId, v_Enabled As Boolean)
On Error Resume Next
For Each cb In Application.CommandBars
If cb.Name <> "Clipboard" Then
For Each it In ctlId
cb.FindControl(, it).Enabled = v_Enabled
Next
End If
Next
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Index = 2 Then ' 2'st sheet in workbook
If Target.Column = 15 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 3 Then ' 3'st sheet in workbook
'End S
If Target.Column = 13 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 4 Then ' 4'st sheet in workbook
If Target.Column = 10 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 5 Then ' 5'st sheet in workbook
If Target.Column = 13 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 5 Then ' 5'st sheet in workbook
If Target.Column = 17 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 6 Then ' 5'st sheet in workbook
If Target.Column = 12 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
If Sh.Index = 6 Then ' 5'st sheet in workbook
If Target.Column = 16 Then ' 15'rd and 4th colums are active
Application.Run ("fecha_hoy") 'Change 'MyMacro to your Macro's name
End If
End If
End Sub


In a Standard module:


Sub CutCopyPasteDisabled()
MsgBox "Lo sentimos, la fecha no puede ser copiada de otra celda"
End Sub


Maybe the error comes with the Sub Workbook_BeforeClose() ??

[fyrigoyeno]

The last one:

When the macro runs on both sheets "PROVEEDORES" and "EMPLEADOS" the warning comes up for ALL the cells, not only for columns 13 and 17 for example.
Thanks in advance

[SamT]

My first read shows to change these subs

Private Sub Workbook_Activate()
ActiveSheet.Range("A1").Select
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_Open()
ActiveSheet.Range("A1").Select
Application.CellDragAndDrop = False
End Sub

It is Very, Very dangerous to use Sheet.Index. It is equally dangerous to use Sheets(OneIndexNumber). Only if you are looping thru all sheets in a workbook should you use Sheets(i).

Here is how I would do this sub.


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ShtName As String
ShtName = Sh.Name
Dim Col As Long
Col = Target.Column
'For certain columns on certain sheets, change Macro name
If ShtName = "Sheet2" And Col = 15 Then Application.Run ("fecha_hoy")
If ShtName = "Sheet3" And (Col = 3 Or Col = 13) Then Application.Run ("fecha_hoy")

[SamT]

You really need to put "Option Explicit" at the top of all your code modules. You have many undeclared variables and this will help you find them.

On the VBA menu >> Tools >> Options >> Editor, I recommend checking everything except Drag And Drop. This will really help you find code mistakes.

[fyrigoyeno]

SamT:
Ok, this is what I'm getting know:
All variables declared (option Explicit at the beggining)

Solved problem in other workbooks with your suggestion:


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ShtName As String
ShtName = Sh.Name
Dim Col As Long
Col = Target.Column
If ShtName = "CLIENTE PN" And Col = 15 Then Application.Run ("fecha_hoy")
If ShtName = "CLIENTE PJ" And Col = 13 Then Application.Run ("fecha_hoy")
If ShtName = "CONCESIONARIOS" And Col = 10 Then Application.Run ("fecha_hoy")
If ShtName = "PROVEEDORES" And (Col = 13 Or Col = 17) Then Application.Run ("fecha_hoy")
If ShtName = "EMPLEADOS" And (Col = 12 Or Col = 16) Then Application.Run ("fecha_hoy")
End Sub

Solved problem (all cells controled) in sheets "PROVEEDORES" and "EMPLEADOS" with:



Case "PROVEEDORES"
If Not Intersect(Selection, Sh.Columns(13)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
ElseIf Not Intersect(Selection, Sh.Columns(17)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(17)) Is Nothing
Else: ToggleCutCopyAndPaste True
End If
Case "EMPLEADOS"
If Not Intersect(Selection, Sh.Columns(12)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(12)) Is Nothing
ElseIf Not Intersect(Selection, Sh.Columns(16)) Is Nothing Then
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(16)) Is Nothing
Else: ToggleCutCopyAndPaste True
End If


Getting error 1004 (error in method select of clase range) with this when closing the workbook:


Private Sub Workbook_Activate()
ActiveSheet.Range("A6").Select
Application.CellDragAndDrop = False
End Sub

[SamT]

Show me the Workbook's BeforeClose and BeforeSave Codes

[snb]

I think you'd better stick to:


Sub ChkSelection(ByVal Sh As Object)



Select Case Sh.Name

Case "CLIENTE PN"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(15)) Is Nothing
Case "CLIENTE PJ"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(13)) Is Nothing
Case "CONCESIONARIOS"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(10)) Is Nothing
Case "PROVEEDORES"
ToggleCutCopyAndPaste Intersect(Selection, range(Sh.Columns(13),Sh.Columns(17)) Is Nothing
Case "EMPLEADOS"
ToggleCutCopyAndPaste Intersect(Selection, Sh.Columns(16)) Is Nothing
Case Else
ToggleCutCopyAndPaste True
End Select

End Sub

[fyrigoyeno]

SamT:

I have only BeforeClose sub:

Option Explicit
Private Sub Workbook_Activate()
ActiveSheet.Range("A6").Select
Application.CellDragAndDrop = False

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ToggleCutCopyAndPaste False
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Deactivate()
ToggleCutCopyAndPaste True
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_Open()
ActiveSheet.Range("A6").Select
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_SheetActivate(ByVal SH As Object)
ChkSelection SH
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal SH As Object, ByVal Target As Range)
ChkSelection SH
End Sub

... continue rest of Sub's...


Snb:

Getting a red line (error compilation) in

Case "PROVEEDORES"
ToggleCutCopyAndPaste Intersect(Selection, range (Sh.Columns(13),Sh.Columns(17)) Is Nothing


And previously tried, with no result (nothing happens, no CutCopyAndPaste control):

ToggleCutCopyAndPaste Intersect(Selection, (Sh.Columns(13)),Sh.Columns(17)) Is Nothing

[snb]

I hardly believe that, but:


ToggleCutCopyAndPaste Intersect(Selection, Range("O:O,Q:Q")) Is Nothing

[fyrigoyeno]

Snb:

Now it's working and is a more simple code

thank you

[KRS]

I wish to disable the cut, paste and copy functions in my workbook executed by the user. I have inserted the module shown in the original post dated 5/5/2008 in this thread. It works! Except for one circumstance. My program can import worksheets from two separate types of Excel files. The first type is a file that does not contain the ToggleCutCopyAndPaste module. The second type does contains the ToggleCutCopyAndPaste module. When my program opens the file type that does not have the "ToggleCut..." module, everything works properly. However, when my program opens the Excel file that does have the ToggleCutCopyAndPaste module, a problem arises. My copy and insert worksheet routine appears to work properly. That is, the file is inserted into the current workbook just as expected. But, when focus is back on the current workbook and I execute any of the copy, cut or paste commands, the file from which the worksheet was copied, is opened; execution of that file's "ThisWorkbook" code begins and eventually crashes. It appears that something is getting imported with the worksheet, but I don't know what.

Curiously, if I save the file and reopen it, it works properly. Even more curious is, immediately after the offending "insert routine" is executed, if I go to any other application (such as NotePad) and perform a Copy Command, Excel crashes.

Can anyone suggest a fix for this or offer any insight?

Thanks,
KenS