Excel vba - Disable paste in multiple cells

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:

If target is more than one cell, you could exit the sub (i.e. not run the code) or loop through each cell in Target. — SJR, May 22 '17 at 12:50

A.S.H · Accepted Answer · 2017-05-22T13:06:42.290

0

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

edited May 22 '17 at 13:06

answered May 22 '17 at 12:52

A.S.H

29,101
5
23
50

Target.Cells.Count > 0 didn't allow me to enter value in a single cell. When I changed it to Target.Cells.Count > 1, the code worked. Thanks! – ksp585 May 22 '17 at 13:05
@ksp585 oops, of course. But you got the idea :). You are welcome. – A.S.H May 22 '17 at 13:07
@A.S.H- What is the use of this line Application.Undo in the code? – ksp585 May 23 '17 at 15:19
@ksp585 *undoes* the change that was done on multiple cells. Somehow simulates `Ctrl+Z`. – A.S.H May 23 '17 at 15:23
@A.S.H- I have encountered another issue with the code. I updated my original question.When you get some time, could you please check and advise? Thank you! – ksp585 May 24 '17 at 05:17
@ksp585 No problem, you're welcome. But please since you are facing now a different issue (applying rules for different sections in Worksheet_Change event), please post a new question, because SO is a Q&A site for the general audience so a reader browsing the site should not get confused. – A.S.H May 24 '17 at 07:32
@A.S.H- Ok, I will raise another question. – ksp585 May 24 '17 at 12:11
1

@A.S.H- Answer in this post solved my question. Thanks! https://stackoverflow.com/questions/16088439/multiple-targets-with-different-macro-calls-in-worksheet-change-vba-code – ksp585 May 24 '17 at 12:27

Excel vba - Disable paste in multiple cells

1 Answers1