Restricting Paste on multiple columns with different Data Validations

[LostinVA]

Hi everyone. I have a worksheet that includes roughly 20/25 different columns. Five of those columns contain Data Validation drop-downs to different data lists. I'm having an issue with users of this worksheet copy/pasting incorrect data over the top of the columns with Data Validation vs. utilizing the drop-downs. Is there a way to restrict or 'lock' the columns with Data Validation so the user is not able to paste and instead has to select a drop-down value?

Hope that made sense. Appreciate any help you can provide!

Regards,
LinVA

 

[Jaafar Tribak]

This should prevent pasting, auto filling and drag & Dropping on cells with Data Validation:

Place code in the Worksheet Module:

Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call MonitorDataValidationRange
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    Call MonitorCellChange(Target:=Target, NotiFyUser:=True)
End Sub


Private Sub MonitorCellChange(ByVal Target As Range, Optional NotiFyUser As Boolean = True)

    Dim sUndoList As String
    
    On Error Resume Next
    If Not Intersect(Target, Range(CommandBars.FindControl(ID:=128).Tag)) Is Nothing Then
        sUndoList = CommandBars.FindControl(ID:=128).List(1)
        If Left(sUndoList, 5) = "Paste" Or sUndoList = "Auto Fill" Or sUndoList = "Drag and Drop" Then
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            If NotiFyUser Then MsgBox "'" & sUndoList & "' On DV cells is not allowed", vbCritical
        End If
    End If

End Sub


Private Sub MonitorDataValidationRange()

    On Error GoTo errHandler
    
    Application.EnableEvents = False
    
        With CommandBars.FindControl(ID:=128)
            If .Tag = "" Then
                .Tag = Cells.SpecialCells(xlCellTypeAllValidation).Address
            End If
            
            If Cells.SpecialCells(xlCellTypeAllValidation).Address <> .Tag Then
                .Tag = ""
            End If
        End With
    
errHandler:
    Application.EnableEvents = True

End Sub

 

[LostinVA]

This should prevent pasting, auto filling and drag & Dropping on cells with Data Validation:

Place code in the Worksheet Module:

Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call MonitorDataValidationRange
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    Call MonitorCellChange(Target:=Target, NotiFyUser:=True)
End Sub


Private Sub MonitorCellChange(ByVal Target As Range, Optional NotiFyUser As Boolean = True)

    Dim sUndoList As String
    
    On Error Resume Next
    If Not Intersect(Target, Range(CommandBars.FindControl(ID:=128).Tag)) Is Nothing Then
        sUndoList = CommandBars.FindControl(ID:=128).List(1)
        If Left(sUndoList, 5) = "Paste" Or sUndoList = "Auto Fill" Or sUndoList = "Drag and Drop" Then
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            If NotiFyUser Then MsgBox "'" & sUndoList & "' On DV cells is not allowed", vbCritical
        End If
    End If

End Sub


Private Sub MonitorDataValidationRange()

    On Error GoTo errHandler
    
    Application.EnableEvents = False
    
        With CommandBars.FindControl(ID:=128)
            If .Tag = "" Then
                .Tag = Cells.SpecialCells(xlCellTypeAllValidation).Address
            End If
            
            If Cells.SpecialCells(xlCellTypeAllValidation).Address <> .Tag Then
                .Tag = ""
            End If
        End With
    
errHandler:
    Application.EnableEvents = True

End Sub

Thank you so much for your help! I'm receiving a 'Compile error: Sub or Function not defined' when trying to click anywhere within the Worksheet?

 

[Jaafar Tribak]

On which line does the error occur ? And do you have any other code in the worksheet module ?

Regards.

 

[LostinVA]

On which line does the error occur ? And do you have any other code in the worksheet module ?

Regards.

Hi there.. It's giving an error from the below. The 'Private Sub ...' row is highlighted yellow and the 'Call MonitorDataValidationRange' line is highlighted as an error.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call MonitorDataValidationRange
End Sub

 

[Jaafar Tribak]

That is very strange!

The compile error you are getting means that the sub called 'MonitorDataValidationRange' doesn't exist which is obviously not the case.

Here is a workbook example

Cells in green are the cells with Data Validation.

 

[Jaafar Tribak]

Have you copied the entire code in Post#2 ... I suspect you mistankenly only copied the top part of the code.

 

[LostinVA]

You were absolutely correct! I neglected to copy the code at the bottom. It works! Thank you thank you! I really appreciate your help!

 

[Jaafar Tribak]

You were absolutely correct! I neglected to copy the code at the bottom. It works! Thank you thank you! I really appreciate your help!

You are welcome.