How to write code to restrict the copy-paste if sheet is having more than one drop-down?

Hi

I have total 4 drop-downs in my sheet A column - Resource Designation , B - User Type, C - Organizational Unit and D - Country.

Previously I have posted my question here for one drop-down Resource Designation. I got the below code from the Forum.

I am trying to change the code for the other three drop-downs as well but getting some errors not code wise but not working as expected.

Can you please help me in combining the same code to work for all 4 drop-downs?


Thanks
Mounika

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cl
Dim MsgTest As Boolean
Set rng = Intersect(Target, Range("A10:A500"))

If rng Is Nothing Then Exit Sub

Application.EnableEvents = 0
Application.ScreenUpdating = 0

On Error Resume Next
MsgTest = False
For Each cl In rng.Cells
If cl.Validation.Value = False Then
If Not MsgTest Then
    MsgBox ("Error : Please select the correct value from the Resource Designation drop-down")
    MsgTest = True
  End If
End If
Next



Application.EnableEvents = 1
Application.ScreenUpdating = 1
End Sub

Hi
Thanks for the reply , but i don't want to disable the paste and copy in my sheet. I just want to pop-up an error message whenever user paste the wrong value in the drop-down. Please find the attached sheet for example , it's already having the code for Resource Designation drop-down , it has total 3 values Clerical, Manager,Professional. If i paste say clerk ,it will throw an error saying please select correct value from drop-down.


I need the similar functionality for remaining drop-downs User Type, Organizational Unit and Country.

But when i used the same code with variable change and range changes, it is not working as expected.Please help me to get through this.


Thanks for the continuous help from the forum members.

Hi

can you please check with other forum members please...


Thanks
Mounika

hi timmu, if your data validation range is A1:D1, option with message and clearing content of the wrong validated cell value

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, cl

Set rng = Intersect(Target, Range("A1:D1"))

If rng Is Nothing Then Exit Sub

Application.EnableEvents = 0

For Each cl In rng.Cells
    If cl.Validation.Value = False Then
        MsgBox ("Please select the correct value from the Resource Designation drop-down in cell " & cl.Address(0, 0)), vbCritical, "Validation error"
        cl.ClearContents
    End If
Next

Application.EnableEvents = 1

End Sub

Hi watersev,

Thanks for your valuable suggestion!!

Actually my range is very large it includes A1:A500 , B1:B500 , C1:C500 and D1:D500. So , I created a Named Range called ValidationRange that includes all these .

The code is working fine but my concern is if we copy in bulk suppose from A10 to D14 then we will get the error message pop-up 24 times and in case of huge bulk copy pop-up will pop 500 times which is not user friendly , so i used the code you said earlier like below:

Now ,it is popping up only once just giving the First cell address i.e.., A10 but not the remaining , is it possible to modify this code further to make it user friendly .. please let me know if we can , thanks for the help.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, cl
Dim MsgTest As Boolean
Set rng = Intersect(Target, Range("ValidationRange"))

If rng Is Nothing Then Exit Sub

Application.EnableEvents = 0
MsgTest = False
For Each cl In rng.Cells
    If cl.Validation.Value = False Then
    If Not MsgTest Then
        MsgBox ("Please select the correct value from the drop-down in cell " & cl.Address(0, 0)), vbCritical, "Validation error"
        cl.ClearContents
         MsgTest = True
    End If
    End If
Next

Application.EnableEvents = 1

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, cl, rng2clear As Range

Set rng = Intersect(Target, Range("ValidationRange"))

If rng Is Nothing Then Exit Sub

Application.EnableEvents = 0

For Each cl In rng.Cells
    If cl.Validation.Value = False Then
        If rng2clear Is Nothing Then Set rng2clear = cl Else Set rng2clear = Union(rng2clear, cl)
    End If
Next

If Not rng2clear Is Nothing Then
    rng2clear.ClearContents
    MsgBox "Range with validation check has been cleared in case of wrong values pasted. Please enter eligible values in validated cells", vbInformation, "Validation error"
End If

Application.EnableEvents = 1

End Sub