Data Validation/Cell Protection Question
Sorry, I didn't restrict value to the range you indicated, so should
be...
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:B")) Is Nothing Then
On Error GoTo ErrorHandler
Dim rgCell As Range
Dim strInvalidCells As String
For Each rgCell In Target.Cells
If rgCell.Value < "" Then
Select Case rgCell.Column
Case 1
Select Case rgCell.Value
Case 1, 3, 5, 7, 9
Case Else
With rgCell
strInvalidCells = strInvalidCells _
& .Value & " in " _
& .Address(False, False) & ", "
Application.EnableEvents = False
.ClearContents
Application.EnableEvents = True
End With
End Select
Case 2
Select Case rgCell.Value
Case 2, 4, 6, 8
Case Else
With rgCell
strInvalidCells = strInvalidCells _
& .Value & " in " _
& .Address(False, False) & ", "
Application.EnableEvents = False
.ClearContents
Application.EnableEvents = True
End With
End Select
End Select
End If
Next rgCell
If Len(strInvalidCells) 0 Then
strInvalidCells = Left(strInvalidCells, _
Len(strInvalidCells) - 2)
MsgBox "Even column A and Odd column B values are invalid!" _
& vbNewLine & _
"The following have been cleared because they were invalid..." _
& vbNewLine & strInvalidCells
End If
Exit Sub
ErrorHandler: Application.EnableEvents = True
End If
End Sub
Ken Johnson
|