Avoid more than one Data validation from being overwrite

[a1b2c3d4]

I'm not much familiar with the VBA, however, do google search and edit to certain extent to customize as per my requirements. After tedious search, I was able to identify below code for avoiding data validation (DV) from being overwritten due to paste actions. But the challenge that I'm facing is I'm able to effect his DV only for one set of range and not multiple.
For date value I used the below code to avoid from being overwritten,

Private Sub Worksheet_Change(ByVal Target As Range)
'updateby Extendoffice 20150530
Set w = ActiveSheet.Range("Q2:S3001")
For Each c In w
If c.Value <> "" And Not IsDate(c) Then
c.ClearContents
MsgBox "Only a date format is permitted in this cell."
End If
Next c
End Sub

but, when I use different code which I got from this forum, it is getting executed at individual capacity, after I exclude the above code. The second code is as follows:

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

Both the above codes are not my creativity, this is something I searched from internet.


Now my concern is that I have multiple DV to be placed in same sheet in multiple columns, any help with some simple DV code, where I can customize for multiple columns.
Help on this is much appreciated.
Thanks in advance!

 

[Yongle]

Re: how to avoid more than one Data validation from being overwrite

It is easy to overcomplicate this. Here is a simple approach
- if addresses of cells containing data validation have changed then undo last action

To test
FIRST add some data validation to various cells in the sheet
THEN add the code below, save, close and reopen the file and see if it does what you want

After testing, I will suggest method to allow you to add new cells with data validation which allows autofill and paste

[B][COLOR=#ff0000]In ThisWorbook module[/COLOR][/B]
Private Sub Workbook_Open()
    OldDV = Sheets("NameOfSheet").Cells.SpecialCells(xlCellTypeAllValidation).Address
    ChangeDV = False
End Sub

[B][COLOR=#ff0000]At TOP of standard module[/COLOR][/B]
Public NewDV As String
Public OldDV As String
Public ChangeDV As Boolean

[B][COLOR=#ff0000]In SHEET module[/COLOR][/B]
Private Sub Worksheet_Change(ByVal Target As Range)
    If ChangeDV = False Then
        On Error Resume Next
        NewDV = Cells.SpecialCells(xlCellTypeAllValidation).Address
        If Not NewDV = OldDV Then Application.Undo
    Else
        ChangeDV = False
        OldDV = Cells.SpecialCells(xlCellTypeAllValidation).Address
    End If
End Sub

 

[a1b2c3d4]

Re: how to avoid more than one Data validation from being overwrite

Thanks Yongle for reply! After putting the codes as guided by you, when I work on that sheet, my excel continues to show it is processing. There is non-stop activity happening as if some macros is running in a loop without any end to it. Also it seems the purpose is not getting fulfilled. Seeking for a solution to this.

 

[Yongle]

Re: how to avoid more than one Data validation from being overwrite

Try what I gave you in a NEW workbook
(I tested the code. It works for me )

Which version of Excel are you running?
(I tested with Excel 2016)

 

[a1b2c3d4]

Re: how to avoid more than one Data validation from being overwrite

Thanks again for assistance! I'm using Excel 2010. I tried my luck in new workbook as well. For my understanding that I'm using the code in correct manner, I'm sharing with you my way of execution. I right click on sheet1 of new workbook and select view code option. then I plot the In ThisWorbook module code under Thisworkbook. 2nd step is plotting At TOP of standard module code by selecting Insert option and then selecting Module. 3rd step is plotting In SHEET module code in sheet name sheet1sheet1. Is it because I'm using Excel 2010 causing problem in executing the code. I have to use task manager function to close the excel.

 

[Yongle]

Re: how to avoid more than one Data validation from being overwrite

I would expect the code to work without a problem in Excel 2010, and has so few lines that it is difficult to understand why it is not working for you

To check that each element of the code is in the correct place
{ALT}{F11} takes you to VBA window
In left window
- double-click on ThisWorkbook - should contain only Private Sub Workbook_Open
- double-click on Module1 - contain only 3 lines declaring Public variables)
- double-click on Sheet1(Sheet1) - should contain only Private Sub Worksheet_Change

[COLOR=#ff0000]Did you amend this line?[/COLOR]
OldDV = Sheets("NameOfSheet").Cells.SpecialCells(xlCellTypeAllValidation).Address
to
OldDV = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Cells.SpecialCells(xlCellTypeAllValidation).Address

Endless loop
The only thing I can think of that might cause the "endless loop" behaviour is that the Change_Event macro is triggerring it
- it does not happen when I test it.
But perhaps disabling and re-enabling the trigger may resolve things - it is good practice to do this in any case
Add the 2 red lines

Private Sub Worksheet_Change(ByVal Target As Range)
    If ChangeDV = False Then
        [COLOR=#ff0000]Application.EnableEvents = False[/COLOR]
        On Error Resume Next
        NewDV = Cells.SpecialCells(xlCellTypeAllValidation).Address
        If Not NewDV = OldDV Then Application.Undo
        [COLOR=#ff0000]Application.EnableEvents = True[/COLOR]
    Else
        ChangeDV = False
        OldDV = Cells.SpecialCells(xlCellTypeAllValidation).Address
    End If
End Sub

Good luck

 

[a1b2c3d4]

Re: how to avoid more than one Data validation from being overwrite

Thanks again Yongle for your help!. This time macros is not getting into a indefinite loop, however, it neither allows me to use validated list of text to key nor it allows me to use text out of the validation list . In both cases my inputs, gets deleted. I'm looking for ways where if I use text which is one out of my given validation list, macros should permit and any text which is not from the given validation list should automatically get deleted. Your guidance is much appreciated.

 

[Yongle]

Re: how to avoid more than one Data validation from being overwrite

I will make a minor amendment to the code and that will be fixed
- I will post by tomorrow

Please test Pasting and Auto-filling(=dragging) and confirm that the code is preventing you from
- pasting to Data Validation cells
- autofilling to Data Validation cells

thanks

 

[Yongle]

Re: how to avoid more than one Data validation from being overwrite

Here you go....

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR=#ff0000]    Dim UndoAction As String
    UndoAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
    If Left(UndoAction, 5) = "Paste" Or UndoAction = "Auto Fill" Then[/COLOR]
        If ChangeDV = False Then
            Application.EnableEvents = False
            On Error Resume Next
            NewDV = Cells.SpecialCells(xlCellTypeAllValidation).Address
            If Not NewDV = OldDV Then Application.Undo
            Application.EnableEvents = True
        Else
            ChangeDV = False
            OldDV = Cells.SpecialCells(xlCellTypeAllValidation).Address
        End If
    [COLOR=#ff0000]End If[/COLOR]
End Sub

 

[a1b2c3d4]

Re: how to avoid more than one Data validation from being overwrite

Thanks a lot Yongle. You're really great. Appreciate your patience and swift reply and also for sharing such a small and customized code, which is really easy to implement. This is be of great help to me.Thanks again!