Need help merging two Worksheet_Change modules

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
 
D

Dave Peterson

I'm confused about what message appears--what part of the code is causing the
error.

And I'm confused about what happened to A6 in the worksheet_change event?


OK, I have managed to get this far. It all works other than after the
messaage appears and it selects the cell again, you can click away from
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 it
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 Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top