Excel vba - Disable paste in multiple cells - excel

Question

I am writing code which compares date entered in one column to date in another column. An error message is displayed if the entry violates data validation rules.
Also, I have disabled cut-paste operation and ctl+d.
Data Validation rules:
Enter valid date between 01/01/1900 and 12/31/9999
Date value in Column AP should be greater than Column AO.
But, when a user copies a cell, selects multiple cells in the target column and pastes, then data validation doesn't trigger at all. Below is the screenshot:
The below code handles single cell operations like copying a cell and paste in another cell but not able to handle when a user selects more than one cell and pastes.
Please help me understand as what is wrong with my code. Thank you!
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandler
Dim lstrow As Long
lstrow = Range("A" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("AP5:AP" & lstrow - 1)) Is Nothing Then Exit Sub
If Target.Value <> "" And Target.Value <= Range("AO" & Target.Row) Then
Application.EnableEvents = False
Target.Value = ""
MsgBox ("The date you have entered is either not in correct format OR less than date in column AO")
Else: Target.NumberFormat = "dd-mmm-yyyy"
End If
ErrorExit:
Application.EnableEvents = True
Exit Sub
ErrorHandler:
Debug.Print Err.Number & vbNewLine & Err.Description
Resume ErrorExit
End Sub
I tried the below code but it didn't work.
if Target.cells.count > 1 then
msgbox("Select a single cell to paste")
ActiveCell.Select
end if
'========================================================================
I have encountered another issue. Now, I want to evaluate one more column in the same worksheet under worksheet_change event. But, code for only one column is getting evaluated and not the other column.
Please advise.
Here is my updated code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Added to define the last row by locating the text string (blank)
On Error GoTo ErrorHandler
Dim lstrow As Long
'ActiveRow = ActiveCell.Row
lstrow = Range("A" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("AP5:AP" & lstrow)) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then
Application.EnableEvents = False
Application.Undo
MsgBox "Select only single cell to paste"
ActiveCell.Select
Application.CutCopyMode = False
Application.EnableEvents = True
Exit Sub
End If
If Target.Value <> "" And Target.Value <= Range("AO" & Target.Row) Then
Application.EnableEvents = False
Target.Value = ""
MsgBox ("The date you have entered is either not in correct format OR less than Column AO")
Else: Target.NumberFormat = "dd-mmm-yyyy"
Application.EnableEvents = True
Exit Sub
End If
'----------------------------------------------------------------------------------
If Intersect(Target, Range("AL5:AL" & lstrow)) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then
Application.EnableEvents = False
Application.Undo
MsgBox "Select only single cell to paste"
ActiveCell.Select
Application.CutCopyMode = False
Application.EnableEvents = True
Exit Sub
End If
If Target.Value <> "" And Target.Value <= Range("AK" & Target.Row) Then
Application.EnableEvents = False
Target.Value = ""
MsgBox ("The value you entered is less than the value in column AK")
Else: Target.NumberFormat = "0.00"
Application.EnableEvents = True
Exit Sub
End If
'----------------------------------------------------------------------------------
ErrorExit:
Application.EnableEvents = True
Exit Sub
ErrorHandler:
Debug.Print Err.Number & vbNewLine & Err.Description
Resume ErrorExit
End Sub
Can we evaluate two different ranges in the same worksheet_change event?
screenshot of the worksheet after the code is run:

Answer 1

After the line
If Intersect(Target, Range("AP5:AP" & lstrow - 1)) Is Nothing Then Exit Sub
Try inserting this additional checking:
If Target.Cells.Count > 1 Then
Application.EnableEvents = False
Application.Undo
msgBox "entering many cells simultaneously in column AP is not allowed"
Application.EnableEvents = True
Exit Sub
End If