Need help merging two Worksheet_Change modules

F

fuzzyfreak

Hi Dave, further to the last entry I have discovered where the module is
tripping up.

It works on three of my cells but any one of a further three cells that
I have data validation in renders the code not to work - what it does
is, on any change to any cell with validation it throws up the message
box in the code (MsgBox "Your last operation was canceled. " & _
"It would have deleted data validation rules.") and doesn't allow you
to do anything else in those cells.

What is it about these particular three cells that causes this? They
are pretty normal validated cells using a list for values with an input
message and an error alert - no different from the three cells that work
fine. One of them spans over two cells but even if I add one of the
others (four validated cells in my named range) it trips up.
 
D

Dave Peterson

I think that there are a couple of different ways you could approach this. You
could keep track of the previous cell (Target is either the cell you're changing
or the cell you're changing to--so that won't help).

Another option would be to look for "invalid" in that "validationRange". If you
find one, just select that cell. (I don't like sendkeys, there's lots that can
go wrong if another application steals focus, but that's up to you.)

I chose the second option. And I added some code to allow only one change at a
time. And instead of checking all the cells in the range to see if the all had
validation, I just checked the one cell that was changing.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

'Does the validation range still have validation?
On Error GoTo errHandler:

If Target.Cells.Count > 1 Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
MsgBox "Only One Cell at a time!"
End If

If Intersect(Target, Me.Range("ValidationRange")) Is Nothing Then
'do nothing
Else
If HasValidation(Target) = False Then
With Application
.EnableEvents = False
.Undo
End With
MsgBox "Your last operation was cancelled. " & _
"It would have deleted data validation rules.", vbCritical
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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim FoundCell As Range

On Error GoTo errHandler:

With Me.Range("ValidationRange")
Set FoundCell = .Cells.Find(what:="Invalid", LookIn:=xlValues, _
Lookat:=xlWhole, _
after:=.Cells(.Cells.Count), MatchCase:=False)
If FoundCell Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
FoundCell.Select
End If
End With

errHandler:
Application.EnableEvents = True

End Sub
 
D

Dave Peterson

Oops. I meant to exit the sub after this portion:

If Target.Cells.Count > 1 Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
MsgBox "Only One Cell at a time!"
Exit Sub '<-- add this line
End If



Dave said:
I think that there are a couple of different ways you could approach this. You
could keep track of the previous cell (Target is either the cell you're changing
or the cell you're changing to--so that won't help).

Another option would be to look for "invalid" in that "validationRange". If you
find one, just select that cell. (I don't like sendkeys, there's lots that can
go wrong if another application steals focus, but that's up to you.)

I chose the second option. And I added some code to allow only one change at a
time. And instead of checking all the cells in the range to see if the all had
validation, I just checked the one cell that was changing.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

'Does the validation range still have validation?
On Error GoTo errHandler:

If Target.Cells.Count > 1 Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
MsgBox "Only One Cell at a time!"
End If

If Intersect(Target, Me.Range("ValidationRange")) Is Nothing Then
'do nothing
Else
If HasValidation(Target) = False Then
With Application
.EnableEvents = False
.Undo
End With
MsgBox "Your last operation was cancelled. " & _
"It would have deleted data validation rules.", vbCritical
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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim FoundCell As Range

On Error GoTo errHandler:

With Me.Range("ValidationRange")
Set FoundCell = .Cells.Find(what:="Invalid", LookIn:=xlValues, _
Lookat:=xlWhole, _
after:=.Cells(.Cells.Count), MatchCase:=False)
If FoundCell Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
FoundCell.Select
End If
End With

errHandler:
Application.EnableEvents = True

End Sub
Click to expand...
 
Top