Data Validation/Cell Protection Question

[Eric]

I distribute a worksheet to many users to supply standardized data inputs and
it includes a lot of validation and cell protection to prevent creativity.
Someone beat my data validation rule for a cell by simply copying & pasting
another cell over it.

In simple terms:
Valid entries for Column A (using a list/dropdown) are odd numbers 1, 3, 5,
7, 9
Valid entries for Column B (using a list/dropdown) are even numbers 2, 4, 6, 8

Copying and pasting cell A1 into B1 allowed someone to get an odd number
into B1.

Additional cell protection in A&B keeps jumping into my mind, but each time
I think about it, I realize protection runs contrary to allowing data input.
Or does it ?

Any suggestions for keeping copy/pasters from getting invalid data into
Column B?

TIA.

 

[Ken Johnson]

I distribute a worksheet to many users to supply standardized data inputs and
it includes a lot of validation and cell protection to prevent creativity.
Someone beat my data validation rule for a cell by simply copying & pasting
another cell over it.

In simple terms:
Valid entries for Column A (using a list/dropdown) are odd numbers 1, 3, 5,
7, 9
Valid entries for Column B (using a list/dropdown) are even numbers 2, 4, 6, 8

Copying and pasting cell A1 into B1 allowed someone to get an odd number
into B1.

Additional cell protection in A&B keeps jumping into my mind, but each time
I think about it, I realize protection runs contrary to allowing data input.
Or does it ?

Any suggestions for keeping copy/pasters from getting invalid data into
Column B?

TIA.

Maybe back up your data validation with a WorksheetChange Event
procedure to deal with copy/pasters.
Something like...

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
With rgCell
If (.Value Mod 2 = 0 And .Column = 1) _
Or (.Value Mod 2 = 1 And .Column = 2) Then
strInvalidCells = strInvalidCells _
& .Value & " in " _
& .Address(False, False) & ", "
Application.EnableEvents = False
.ClearContents
Application.EnableEvents = True
End If
End With
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

 

[Ken Johnson]

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