F
fuzzyfreak
OK, I have managed to get this far. It all works other than after th
messaage appears and it selects the cell again, you can click away fro
the cell -
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errHandler:
'Does the validation range still have validation?
If HasValidation(Me.Range("ValidationRange")) = False Then
With Application
.EnableEvents = False
.Undo
End With
MsgBox "Your last operation was canceled. " & _
"It would have deleted data validation rules.", vbCritical
Else
If Intersect(Target, Me.Range("ValidationRange")) Is Nothing Then
'do nothing
Else
With Target
If .Value = "" Then
Application.EnableEvents = False
.Value = "Invalid"
MsgBox "You have an invalid entry, please try again."
.Select
SendKeys "%{Down}"
End If
End With
End If
End If
errHandler:
Application.EnableEvents = True
End Sub
Private Function HasValidation(r) As Boolean
' Returns True if every cell in Range r uses Data Validation
Dim X As String
On Error Resume Next
X = r.Validation.Type
If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function
--------------------------------------
This module works on its own but I can't see what I have missed from i
in my module above -
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$6" And [A6].Value = "Invalid" Then
MsgBox "You have an invalid entry in cell A6"
[A6].Select
SendKeys "%{Down}"
End If
End Su
messaage appears and it selects the cell again, you can click away fro
the cell -
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errHandler:
'Does the validation range still have validation?
If HasValidation(Me.Range("ValidationRange")) = False Then
With Application
.EnableEvents = False
.Undo
End With
MsgBox "Your last operation was canceled. " & _
"It would have deleted data validation rules.", vbCritical
Else
If Intersect(Target, Me.Range("ValidationRange")) Is Nothing Then
'do nothing
Else
With Target
If .Value = "" Then
Application.EnableEvents = False
.Value = "Invalid"
MsgBox "You have an invalid entry, please try again."
.Select
SendKeys "%{Down}"
End If
End With
End If
End If
errHandler:
Application.EnableEvents = True
End Sub
Private Function HasValidation(r) As Boolean
' Returns True if every cell in Range r uses Data Validation
Dim X As String
On Error Resume Next
X = r.Validation.Type
If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function
--------------------------------------
This module works on its own but I can't see what I have missed from i
in my module above -
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$6" And [A6].Value = "Invalid" Then
MsgBox "You have an invalid entry in cell A6"
[A6].Select
SendKeys "%{Down}"
End If
End Su