Can a named range be protected???

  • Thread starter Thread starter John D
  • Start date Start date
J

John D

For example, If I had a worksheet used to collect 10
financial values, with the 10 cells named FinVal1 thru
FinVal10 respectively, locked all other cells on the
sheet, protected the sheet...

Now, as an example if a user Cuts the cell named FinVal1
and pastes it over the cell that is named FinVal6, then
FinVal6 will no longer exist.

Is here a way to prevent users from pasting cell obects
over others that are named? This silently creates havoc
elsewhere in the spreadsheet that may reference the
former named range.
 
John said:
Is here a way to prevent users from pasting cell obects
over others that are named? This silently creates havoc
elsewhere in the spreadsheet that may reference the
former named range.
Click to expand...

You would need to disable the ability to Cut (or replace Paste with
Paste Special / Values)

Something like this:

In a normal module:

Sub MyPaste()
If ActiveWorkbook.Name = ThisWorkbook.Name Then
ActiveCell.PasteSpecial xlValues
Else
ActiveSheet.Paste
End If
End Sub

Sub GrabCutAndPaste()
Dim CB As CommandBar
Dim CTL As CommandBarControl
For Each CB In Application.CommandBars
Set CTL = CB.FindControl(ID:=22, recursive:=True)
If Not CTL Is Nothing Then
CTL.OnAction = "MyPaste"
End If
' disable cut
Set CTL = CB.FindControl(ID:=21, recursive:=True)
If Not CTL Is Nothing Then
CTL.Enabled = False
End If

Next
Application.OnKey "^x", ""
Application.OnKey "+{DELETE}", ""
Application.OnKey "^v", "MyPaste"
Application.OnKey "+{INSERT}", "MyPaste"
Application.CellDragAndDrop = False
Application.CutCopyMode = False
End Sub

Sub ReleaseCutAndPaste()
Dim CB As CommandBar
Dim CTL As CommandBarControl
For Each CB In Application.CommandBars
Set CTL = CB.FindControl(ID:=22, recursive:=True)
If Not CTL Is Nothing Then
CTL.OnAction = ""
End If
' enable cut
Set CTL = CB.FindControl(ID:=21, recursive:=True)
If Not CTL Is Nothing Then
CTL.Enabled = True
End If
Next
Application.OnKey "^x"
Application.OnKey "+{DELETE}"
Application.OnKey "^v"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
End Sub

' and in ThisWorkbook

Private Sub Workbook_Activate()
GrabCutAndPaste
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ReleaseCutAndPaste
End Sub

Private Sub Workbook_Open()
GrabCutAndPaste
End Sub


Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - reply in newsgroup
 
Back
Top