Need help merging two Worksheet_Change modules

F

fuzzyfreak

I have been give the two modules below, both of which perform some
validation on certain cells. The first one stops anybody from trying
to remove set data validation by way of pasting into the cell (one of
data validation's flaws) the second one stops anybody from deleting or
leaving a cell blank when they should be selecting a value from a
list.

As you can see, the first part of each module starts "Worksheet_Change"
so VB doesn't like this. How do I go about merging both my modules so
it works?

thanks

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

_Second_Module_
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$6" Then Exit Sub
If Target.Value = "" Then Target.Value = "Invalid"
End Sub

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
 
D

Dave Peterson

I think that this does what you want:

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("a6")) Is Nothing Then
'do nothing
Else
With Target
If .Value = "" Then
Application.EnableEvents = False
.Value = "Invalid"
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


I have been give the two modules below, both of which perform some
validation on certain cells. The first one stops anybody from trying
to remove set data validation by way of pasting into the cell (one of
data validation's flaws) the second one stops anybody from deleting or
leaving a cell blank when they should be selecting a value from a
list.

As you can see, the first part of each module starts "Worksheet_Change"
so VB doesn't like this. How do I go about merging both my modules so
it works?

thanks

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

_Second_Module_
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$6" Then Exit Sub
If Target.Value = "" Then Target.Value = "Invalid"
End Sub

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