VBA-Macro Prevent Copy Paste in Data Validation Cell

[Morshed_Dhaka]

Hello Everyone, I am facing a critical problem which I believe require macro to solve this problem. I tried to create the macro so many times but it is not working and not solving my problems. Really appreciate is some body helps me to solve this problem

In a worksheet I implied data validation rules within the cells "E7:E12". Data validation list data is already available in the file . When I select the data from drop down, it works perfectly. Also, If I want to type any data which is not available in the drop down menu it stops me and showing me error message. It also works fine.

But when I copy-paste-value paste data in those data validation cells from any other location, it captured the data and doesn't imply the data validation rules.

I am looking for a macro that will restrict user to copy/paste/value paste any data from anywhere except the data which is already available in data validation list. The macro should be applicable for only selected range. In this case the range should be "E7: E12". In addition, if it can be done that if someone copy paste data from other location which has mixture of available & non available data & when user copy paste it, only available data will be taken and non available data will be automatically deleted with warning message box.

I am looking for expert help in this regard. I will ever grateful if someone able to give me the solution. Thanks.

 

[Morshed_Dhaka]

o my god, my dear Joe brother it is absolutely correct now. only three things I need to change to imply this code. hats off to you. Many many thanks. you made my day.

hope we will talk here again. until then, good bye and many thanks again.

Best Regards,
S.M.Morshed Hemal
Dhaka, Bangladesh.

 

[Joe4]

You are welcome.
Glad I was able to help!

 

[Deepika23]

OK. Try this. I put all the ranges that may change at the very top as range variables. So those should be the only three things in the code that you may need to change.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range
    Dim rng2 As Range
    Dim isect As Range
    Dim isect2 As Range
    Dim cell As Range
    Dim dd() As Variant
    Dim i As Long
    Dim mtch As Boolean
    Dim msg As String
    Dim myEntries As String
    Dim ddRange As Range
    
'***Set column E validation range
    Set rng1 = Range("E7:E12")
'***Set column A validation range
    Set rng2 = Range("A1:A100")
'***Set drop-down list value range
    Set ddRange = Sheets("Sheet1").Range("A1:A3")
    
    
'   See if any updated cells fall in column E range
    Set isect = Intersect(rng1, Target)
'   See if any updated cells fall in column A range
    Set isect2 = Intersect(rng2, Target)
    
'   Exit if updated cells do not fall in either validation range
    If (isect Is Nothing) And (isect2 Is Nothing) Then Exit Sub
    
    Application.EnableEvents = False


'   First check (column E)
    If Not isect Is Nothing Then
'       Build array of drop-down values
        ReDim dd(ddRange.Cells.Count)
        i = 0
        For Each cell In ddRange
            dd(i) = cell.Value
            i = i + 1
        Next cell
    
'       Loop through all intersecting cells
        For Each cell In isect
'           See if cell entry matches any drop-down values
            mtch = False
            For i = LBound(dd) To UBound(dd)
                If cell.Value = dd(i) Then
                    mtch = True
                    Exit For
                End If
            Next i
'           If value is not in list, erase and return message
            If mtch = False Then
                cell.ClearContents
                msg = msg & cell.Address(0, 0) & ","
            End If
        Next cell


'       Build string of validation entries
        For i = LBound(dd) To UBound(dd)
            myEntries = myEntries & dd(i) & ","
        Next i
        myEntries = Left(myEntries, Len(myEntries) - 1)
    
'       Reset validation
        With rng1.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=myEntries
        End With
    
'       Return message, if necessary
        If Len(msg) > 0 Then
            MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
        End If
    End If
    

'   Second check (column A)
    If Not isect2 Is Nothing Then
'       Loop through all intersecting cells
        For Each cell In isect2
            If (Len(cell) > 0) And (Len(cell) <> 11) Then
                cell.ClearContents
                msg = msg & cell.Address(0, 0) & ","
            End If
        Next cell
            
'       Reset validation
        With rng2.Validation
            .Delete
            .Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _
                Operator:=xlEqual, Formula1:="11"
        End With
    
'       Return message, if necessary
        If Len(msg) > 0 Then
            MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
        End If
    End If
    
    Application.EnableEvents = True

End Sub

I need a similar code but then i need to apply to multiple columns.
E.g. Country Name dropdown, First Name & Last Name drop down.

Can you please help me urgently on this!

 

[Joe4]

I need a similar code but then i need to apply to multiple columns.
E.g. Country Name dropdown, First Name & Last Name drop down.

Have you tried to adapt the code you I created?
What part is tripping you up?

This code is very particular and dependent upon the details. We really cannot create anything that will work on your data without those exact details, like:
- What is each field/column that it needs to be applied to?
- Where are the drop-down values coming from? Name fields do not seem like they would be static lists.

 

[aboly8000]

OK, I have created Worksheet_Change event procedure code that should do what you want. I even added code so that if they Copy and Paste values in, it will put the original Data Validation drop-down back in.
The only thing you should need to change is the array value in the dd variable (these are your drop-down values).
This code needs to be placed in proper sheet module. If you are unsure where to place it, just go to the sheet you want to apply it to, right-click on the sheet tab name at the bottom of the screen, select View Code, and paste the code in the resulting VBA editor window. Everything else should be automatic.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim isect As Range
    Dim cell As Range
    Dim dd As Variant
    Dim i As Long
    Dim mtch As Boolean
    Dim msg As String
    Dim myEntries As String
    
'   See if any updated cells fall in E7:E12
    Set isect = Intersect(Range("E7:E12"), Target)
    
'   Exit if updated cells do not fall in E7:E12
    If isect Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
'   Set drop-down values
    dd = Array("apple", "banana", "cherry")
    
'   Loop through all intersecting cells
    For Each cell In isect
'       See if cell entry matches any drop-down values
        mtch = False
        For i = LBound(dd) To UBound(dd)
            If cell.Value = dd(i) Then
                mtch = True
                Exit For
            End If
        Next i
'       If value is not in list, erase and return message
        If mtch = False Then
            cell.ClearContents
            msg = msg & cell.Address(0, 0) & ","
        End If
    Next cell
    
'   Build string of validation entries
    For i = LBound(dd) To UBound(dd)
        myEntries = myEntries & dd(i) & ","
    Next i
    myEntries = Left(myEntries, Len(myEntries) - 1)
    
'   Reset validation
    With Range("E7:E12").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=myEntries
'        .IgnoreBlank = True
'        .InCellDropdown = True
'        .InputTitle = ""
'        .ErrorTitle = ""
'        .InputMessage = ""
'        .ErrorMessage = ""
'        .ShowInput = True
'        .ShowError = True
    End With
    
'   Return message, if necessary
    If Len(msg) > 0 Then
        MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
    End If

    Application.EnableEvents = True

End Sub

Hello
Thank you very much for your interesting and useful programming
Is it possible to organize this code for my needs?
My Needs:
- A:A , I:I range. Data validation rules implies that : Allow = "decimal" , Data = "greater than", minimum = "1"
- B:B range. Accept information only from UserForm3.Show
i use this code for that:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Cancel = True
Dim ads, ads1, val As String
ads = Target.Address
ads1 = Mid(ads, 2, 2)
'val = Target.Value
If ads1 = "B$" Then
val = Target.Value
UserForm3.Show
End If
Cancel = True
End Sub
- D:D , E:E , F:F , G:G , H:H range. Data validation rules implies that : Allow = "list" , ignore blank , in-cell dropdown , source = "=Sheet2!$A$2:$A$100"
- J:J range. Data validation rules implies that : Allow = "decimal" , Data = "between" , minimum = "1" maximum = "100"

 

[Joe4]

Your question is different enough that it should probably be asked in its own thread (especially since you are introducing new features like User Forms). I really do not do much programming with User Forms in Excel (I found them to be quite cumbersome and prefer Access if I need forms), so I don't know how much help I would be able to be anyway.

It is usually best to post your questions to a new thread instead of posting to an old thread. Then it will appear as a new unanswered question in the "Zero Reply Posts" listing many people use to look for new unanswered questions. If you feel that another old thread may be helpful, you can always include a link in your question to that old thread.

 

[aboly8000]

Your question is different enough that it should probably be asked in its own thread (especially since you are introducing new features like User Forms). I really do not do much programming with User Forms in Excel (I found them to be quite cumbersome and prefer Access if I need forms), so I don't know how much help I would be able to be anyway.

It is usually best to post your questions to a new thread instead of posting to an old thread. Then it will appear as a new unanswered question in the "Zero Reply Posts" listing many people use to look for new unanswered questions. If you feel that another old thread may be helpful, you can always include a link in your question to that old thread.

Forget the user form.
If possible, organize the code for the following needs:

- A:A , I:I range. Data validation rules implies that : Allow = "decimal" , Data = "greater than", minimum = "1"
- B:B range. Data validation rules implies that : Allow = "custom" , ignore blank , formula =
- D:D , E:E , F:F , G:G , H:H range. Data validation rules implies that : Allow = "list" , ignore blank , in-cell dropdown , source = "=Sheet2!$A$2:$A$100"
- J:J range. Data validation rules implies that : Allow = "decimal" , Data = "between" , minimum = "1" maximum = "100"

 

[Joe4]

Forget the user form.
If possible, organize the code for the following needs:

- A:A , I:I range. Data validation rules implies that : Allow = "decimal" , Data = "greater than", minimum = "1"
- B:B range. Data validation rules implies that : Allow = "custom" , ignore blank , formula =
- D:D , E:E , F:F , G:G , H:H range. Data validation rules implies that : Allow = "list" , ignore blank , in-cell dropdown , source = "=Sheet2!$A$2:$A$100"
- J:J range. Data validation rules implies that : Allow = "decimal" , Data = "between" , minimum = "1" maximum = "100"

You should be able to employ the same logic that I used in the thread. The kay to getting the needed Data Validation code is to turn on the Macro Recorder, and record yourself setting up that Data Validation manually. That will give you the code you need to insert into the VBA code to set up the Validation.

Try giving it a shot, setting up the first one and see how you do (and post back here with what you came up with if you need help).

However, if you are already using User Forms, it might be even better to not allow them to enter anything to the worksheet directly, and make them enter everything through the User Form, where you can more easily control what they entries (as then there would only be one way to enter data, as opposed to manual entry or copy/paste).

 

[aboly8000]

OK. Try this. I put all the ranges that may change at the very top as range variables. So those should be the only three things in the code that you may need to change.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range
    Dim rng2 As Range
    Dim isect As Range
    Dim isect2 As Range
    Dim cell As Range
    Dim dd() As Variant
    Dim i As Long
    Dim mtch As Boolean
    Dim msg As String
    Dim myEntries As String
    Dim ddRange As Range
    
'***Set column E validation range
    Set rng1 = Range("E7:E12")
'***Set column A validation range
    Set rng2 = Range("A1:A100")
'***Set drop-down list value range
    Set ddRange = Sheets("Sheet1").Range("A1:A3")
    
    
'   See if any updated cells fall in column E range
    Set isect = Intersect(rng1, Target)
'   See if any updated cells fall in column A range
    Set isect2 = Intersect(rng2, Target)
    
'   Exit if updated cells do not fall in either validation range
    If (isect Is Nothing) And (isect2 Is Nothing) Then Exit Sub
    
    Application.EnableEvents = False


'   First check (column E)
    If Not isect Is Nothing Then
'       Build array of drop-down values
        ReDim dd(ddRange.Cells.Count)
        i = 0
        For Each cell In ddRange
            dd(i) = cell.Value
            i = i + 1
        Next cell
    
'       Loop through all intersecting cells
        For Each cell In isect
'           See if cell entry matches any drop-down values
            mtch = False
            For i = LBound(dd) To UBound(dd)
                If cell.Value = dd(i) Then
                    mtch = True
                    Exit For
                End If
            Next i
'           If value is not in list, erase and return message
            If mtch = False Then
                cell.ClearContents
                msg = msg & cell.Address(0, 0) & ","
            End If
        Next cell


'       Build string of validation entries
        For i = LBound(dd) To UBound(dd)
            myEntries = myEntries & dd(i) & ","
        Next i
        myEntries = Left(myEntries, Len(myEntries) - 1)
    
'       Reset validation
        With rng1.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=myEntries
        End With
    
'       Return message, if necessary
        If Len(msg) > 0 Then
            MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
        End If
    End If
    

'   Second check (column A)
    If Not isect2 Is Nothing Then
'       Loop through all intersecting cells
        For Each cell In isect2
            If (Len(cell) > 0) And (Len(cell) <> 11) Then
                cell.ClearContents
                msg = msg & cell.Address(0, 0) & ","
            End If
        Next cell
            
'       Reset validation
        With rng2.Validation
            .Delete
            .Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _
                Operator:=xlEqual, Formula1:="11"
        End With
    
'       Return message, if necessary
        If Len(msg) > 0 Then
            MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
        End If
    End If
    
    Application.EnableEvents = True

End Sub

Hello
In the above code, I get the following error when I copy and paste a lot of information.
please guide me

 

[Joe4]

Without having access to the data file, and knowing exactly the range you are trying to copy, I really have no idea.