Preventing Data Validation from being deleted

underdunk

Board Regular
Joined
Oct 3, 2005
Messages
74
I have this code that does not allow users to paste over cells with data validation

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    'Does the validation range still have validation?
    If HasValidation(Range("J10:J1999")) Then
        Exit Sub
    Else
        Application.Undo
        MsgBox "Please enter a valid date.", vbCritical
    End If
End Sub

Private Function HasValidation(r) As Boolean
'   Returns True if every cell in Range r uses Data Validation
    On Error Resume Next
    x = r.Validation.Type
    If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function

It works great until I protect the sheet and have these cells unlocked, it allows any value to be pasted into the cells.
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Mister H

Well-known Member
Joined
Mar 6, 2002
Messages
1,507
Hi underdunk:

Not sure what your file is used for but if it is just a template type of file you could set your original file as Read Only and then the user can not save over the original file. Maybe this would not work in your situation but thought I would throw it out there anyway. If you need any clarification just let me know.

Bye 4 Now,
Mark
 

Gingertrees

Well-known Member
Joined
Sep 21, 2009
Messages
697
Best thing would be to disable cut/paste all together. This is some of my favorite code, that I think I got from mdmackillop and/or GTO over at VBA Express. It goes in the ThisWorkbook module.
NOTE: works best with some additional code to force user to enable macros (otherwise they can copy/paste to their hearts' content):
Code:
Option Explicit
Dim bolMyOverride As Boolean
'this is your backdoor in, so YOU can run EnableStuff... and do copy/paste,
'but your users cannot.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    With Application
        .EnableCancelKey = xlDisabled
        .ScreenUpdating = False
        Call HideSheets
        .ScreenUpdating = True
        .EnableCancelKey = xlInterrupt
    End With
End Sub
Private Sub Workbook_Activate()
     
     '// After you have run 'EnableStuffSoICanWork()', then the Boolean 'bolMyOverride' //
     '// equals TRUE. //
     
     '// So... assuming you've run the aforementioned sub and bolMyOverride has been set //
     '// to True, the below test fails, and 'CutCopy_Disable' is never called. In short,//
     '// as long as bolMyOverride retains a value of True, you can make mods w/o //
     '// interference, as long as you don't reset. //
    If Not bolMyOverride Then
         '// Code moved to own sub //
        Call CutCopy_Disable
    End If
End Sub
 
Private Sub Workbook_Deactivate()
     
     '// SAA //
    If Not bolMyOverride Then
        Call CutCopy_Enable
    End If
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
     
    If Not bolMyOverride Then
        With Application
            .CellDragAndDrop = False
            .CutCopyMode = False 'Clear clipboard
        End With
    End If
End Sub

Private Sub EnableStuffSoICanWork()
    Call CutCopy_Enable
    bolMyOverride = True
End Sub
 
Private Sub DisableStuffSoOthersCannotGooberUpMyDay()
    Call CutCopy_Disable
    bolMyOverride = False
     '// Optional of course //
    ThisWorkbook.Save
End Sub
 
Private Sub CutCopy_Disable()
    Dim oCtrl As Office.CommandBarControl
     
     'Disable all Cut menus
    For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
        oCtrl.Enabled = False
    Next oCtrl
     
     'Disable all Copy menus
    For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
        oCtrl.Enabled = False
    Next oCtrl
     
    Application.CellDragAndDrop = False
End Sub
 
Private Sub CutCopy_Enable()
    Dim oCtrl As Office.CommandBarControl
     
     'Enable all Cut menus
    For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
        oCtrl.Enabled = True
    Next oCtrl
     
     'Enable all Copy menus
    For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
        oCtrl.Enabled = True
    Next oCtrl
     
    Application.CellDragAndDrop = True
End Sub
 

underdunk

Board Regular
Joined
Oct 3, 2005
Messages
74
Thanks for the suggestions, but I think disabling copying and pasting is a bit extreme. I just don't want them to do it in the specified cells.
 

Gingertrees

Well-known Member
Joined
Sep 21, 2009
Messages
697
That's what I thought at first - but it saves you headaches in the long run. Remember that the simple fact that you can write code puts you ahead of the vast majority of office drones. You would NEVER think to ignore a Read Only error, or type a phone number using back-slashes, or enter a date with a 3-digit year...but there are lots of folks who will. Some of those folks will use your workbook.
Cheers:LOL:,
~G
 

Watch MrExcel Video

Forum statistics

Threads
1,122,518
Messages
5,596,630
Members
414,082
Latest member
sasmita

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top