Intercepting the 'Cut' Operation

I am looking for a way to stop users using the cut operation, and if a user does try to cut data, to instead have a macro that will copy/paste the data then clear the initial cell contents.

I want this as the users of the spreadsheet are only entering data, but this data is collected by another sheet in the workbook which gets screwed up if cells are cut and pasted.

I ideally don't want to completely disable the cut operation, just change it as described above.

I have currently got this code in the "ThisWorkbook" object:


Private Sub Workbook_Open()

Cell1 = ActiveCell.AddressLocal

End Sub

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

If Application.CutCopyMode = xlCut Then
Range(Cell1).Copy

Else
Cell1 = ActiveCell.AddressLocal

End If

End Sub


'Cell1' is the range which has been cut, or the currently active cell if nothing has been cut

The Workbook_Open code is in case the user doesn't move the cursor before cutting.

As you can see I have got code to check if the CutCopyMode is set to Cut once the user moves the cursor (which they will have to do in order to paste elsewhere) and then changes the mode to copy rather than cut, but this is as far as I can get..

I don't know of a way to tell if the user has pasted the data to a cell, the only way I can think of is to get then next cell they select, store it's value, then on the next move, compare that cells' value with 'Cell1''s value, if they match, clear the contents of 'Cell1', but this is quite messy, as the user will be expecting the original data to disappear when they press paste, but it will only go once they move again.

Therefore I am looking for a better, neater way of doing it.

Thanks in advance for any help.

Hello

Try;

In ThisWorkbook:
Private Sub Workbook_Open()
Dim cbr As CommandBar, ctl As CommandBarControl

For Each cbr In Application.CommandBars
Set ctl = cbr.FindControl(ID:=21, Recursive:=True)
If Not ctl Is Nothing Then ctl.OnAction = "CutToCopy"
Next cbr
Application.OnKey "^x", "CutToCopy"
End Sub

Private Sub Workbook_Activate()
Dim cbr As CommandBar, ctl As CommandBarControl

For Each cbr In Application.CommandBars
Set ctl = cbr.FindControl(ID:=21, Recursive:=True)
If Not ctl Is Nothing Then ctl.OnAction = "CutToCopy"
Next cbr
Application.OnKey "^x", "CutToCopy"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim cbr As CommandBar, ctl As CommandBarControl

For Each cbr In Application.CommandBars
Set ctl = cbr.FindControl(ID:=21, Recursive:=True)
If Not ctl Is Nothing Then ctl.Reset
Next cbr
Application.OnKey "^x"
End Sub

Private Sub Workbook_Deactivate()
Dim cbr As CommandBar, ctl As CommandBarControl

For Each cbr In Application.CommandBars
Set ctl = cbr.FindControl(ID:=21, Recursive:=True)
If Not ctl Is Nothing Then ctl.Reset
Next cbr
Application.OnKey "^x"
End Sub


In Standard Module:
Private Sub CutToCopy()
Selection.Copy
End Sub


Regards
Jon von der Heyden

ok looks good, will this work with right click>cut or edit>cut (or the cut button on the command bar)

looks to me like this will only intercept ctrl+x, which is not very effective since most of the users will not know what ctrl+x does, so will never use it

thanks

Hi

This captures shortcut, right-click menu and the controls on the menu bar and other toolbars.

Hi JON

tried this and it works great

thanks for that :D

another quick question though, i take it that in the line 'FindControl(ID:=21, Recursive:=True)', the ID for cut is 21?

how do i find the id's for other commands? for instance, now that the user cannot cut data, but rather is now copying and pasting it, i would like to be able to clear the contents of the original cells

using the code you gave me for the normal module:

Sub CutToCopy()

Selection.Copy
selRange = ActiveWindow.RangeSelection.Address

End Sub

i have added a Public variable 'selRange' which will get the selected range at the time it is copied.

all i need now is to know when the user has pasted the data, so the original cells can be cleared.

thanks in advance

-----------------
EDIT found how to display the control ID through the help file:

Sub test()

For Each ctl In CommandBars("Standard").Controls
ctl.Caption = CStr(ctl.ID)
Next ctl

End Sub
and to reset them just right click on the command bar and choose 'Customise...' then 'Toolbars', 'Standard', 'Reset..' to get it back to normal

-----------------
EDIT2 ok i have done it and made it work, here is what i changed:

Private Sub Workbook_Open()

Dim cbr As CommandBar, ctlCut As CommandBarControl, ctlPaste As CommandBarControl

For Each cbr In Application.CommandBars
Set ctlCut = cbr.FindControl(ID:=21, Recursive:=True)
Set ctlPaste = cbr.FindControl(ID:=22, Recursive:=True)
If Not ctlCut Is Nothing Then ctlCut.Reset
If Not ctlPaste Is Nothing Then ctlPaste.Reset
Next cbr

Application.OnKey "^x"
Application.OnKey "^v"

End Sub

i have changed the variable 'ctl' to 'ctlCut' so that i can add a 2nd one, 'ctlPaste'
added a line to find the Paste control (ID 22)
added a line to reset (or set) the variable
added another Application.OnKey for paste

these are changes done to all 4 private procedures (WB_Open/Close/Activate/Deactivate)

then i added a public variable to store the initial cut range
Public selRange

Sub CutToCopy()

Selection.Copy
selRange = ActiveWindow.RangeSelection.Address

End Sub


then wrote code for pasting the data
if the selRange variable isn't empty then the user has cut the data, so clear the contents of that range

Sub ClearCells()

On Error GoTo ErrorHandler

ActiveSheet.Paste

If selRange <> "" Then
Range(selRange).ClearContents
End If

selRange = ""

ErrorHandler:
If Err = 1004 Then
MsgBox "Cannot paste into protected cells. Please try again.", vbOKOnly
End If

End Sub


the error handler should be self explanitary, i couldn't think of any other errors that could crop up, but i welcome any suggestions :P

and thanks for the original code and inspiration :)