prevent deleting Data Validation

R

rakumar

New member
Joined
Oct 13, 2013
Messages
4
Reaction score
0
Points
0
Hi,

I have this code

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
'Does the validation range still have validation?
If HasValidation(Range("E2:F32")) Then
Exit Sub
Else
Application.Undo
MsgBox "Your last operation was canceled." & _
"It would have deleted data validation rules.", vbCritical
End If
Application.EnableEvents = True
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

Which stops deleting and it also stops pasting it in any cell.

But when I choose anything from the list it gives me an error.

please help me out with this
 
1. There's going to be a serious problem with:
Code: 
Application.EnableEvents = False
    'Does the validation range still have validation?
    If HasValidation(Range("E2:F32")) Then
        Exit Sub
    Else
because set EnableEvents to False, if the range has intact data validation, the Exit sub gets executed while Enable events is still false, so you have no cxhance of catchimng subsequent data validation infractions.

2. I was unable to duplicate your scenarion unless I started out with a data validation already missing from that range.

3. It may serve you to check that the cell(s) that have changed include cell(s) in the in the data validation range that you want to protect.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set xxx = Intersect(Target, Range("E2:F32"))
If Not xxx Is Nothing Then
  'Does the validation range still have validation?
  If HasValidation(Range("E2:F32")) Then
    Exit Sub
  Else
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    MsgBox "Your last operation was cancelled. It would have deleted data validation rules.", vbCritical
  End If
End If
End Sub
If there is more than one data validation range you want to protect then a tweak is required.
 
p45cal said:
1. There's going to be a serious problem with:
Code: 
Application.EnableEvents = False
    'Does the validation range still have validation?
    If HasValidation(Range("E2:F32")) Then
        Exit Sub
    Else
because set EnableEvents to False, if the range has intact data validation, the Exit sub gets executed while Enable events is still false, so you have no cxhance of catchimng subsequent data validation infractions.

2. I was unable to duplicate your scenarion unless I started out with a data validation already missing from that range.

3. It may serve you to check that the cell(s) that have changed include cell(s) in the in the data validation range that you want to protect.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set xxx = Intersect(Target, Range("E2:F32"))
If Not xxx Is Nothing Then
  'Does the validation range still have validation?
  If HasValidation(Range("E2:F32")) Then
    Exit Sub
  Else
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    MsgBox "Your last operation was cancelled. It would have deleted data validation rules.", vbCritical
  End If
End If
End Sub
If there is more than one data validation range you want to protect then a tweak is required.
Click to expand...


Thanks But its doing the same thing.

It keeps on getting an error and doing the same thing.

What is XXX in your code. yes there is one more validation in the column H2:H32. I have changed that in the range but its still doing the same thing.
here is the code

Private Sub Worksheet_Change(ByVal Target As Range)
Set xxx = Intersect(Target, Range("E2:F32,H2:H32"))
If Not xxx Is Nothing Then
'Does the validation range still have validation?
If HasValidation(Range("E2:F32,H2:H32")) Then
Exit Sub
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "Your last operation was cancelled. It would have deleted data validation rules.", vbCritical
End If
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

I am puting this ode in sheet 1 module under Microsoft Excel Objects

E2:F32 has a list validation and H2 : H32 has custom validaion
 
You have tried to use the .Type property of data validation, and whether that raises an error, to determine if a range of cells all contain data validation. Only if ALL the cells of the range contain validation, and that validation is the same validation across the whole range (this includes, if the DV is a list, that the list should be the same list throughout).
If there are different DVs in the range you want to protect you're going to have to test the cells individually, rather than as a block.

Try changing to:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set xxx = Intersect(Target, Range("E2:F32,H2:H32")) 'it's a range that is the intersection of the cells you have tried to change (Target) and the cells that have DV that you want to protect.
If Not xxx Is Nothing Then
  'Does the validation range still have validation?
If HasValidation(xxx) Then
    Exit Sub
  Else
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    MsgBox "Your last operation was cancelled. It would have deleted data validation rules.", vbCritical
  End If
End If
End Sub


Private Function HasValidation(r) As Boolean
HasValidation = True
'Returns True if every cell in Range r uses Data Validation
On Error Resume Next
For Each cll In r.Cells
  x = cll.Validation.Type
  If Err.Number <> 0 Then
    HasValidation = False
    Exit For
  End If
Next cll
End Function
 
You must log in or register to reply here.
Back
Top