Preventing Paste function in cells that have a Validation operation.

[martinllawrence]

I have a spreadsheet that is password protected, in which I have cells that have Validation Dropdown lists, how can I stop users from pasting data into these Cells?

I have dealt with the issues around typing entries rather than selecting from the list, but this is one issue I cannot seem to resolve.

 

[Jaafar Tribak]

Hi and welcome to the forum

You can set Application.CutCopyMode to False as follows : (where cell A1 is the validation entry cell)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Application.CutCopyMode = False
    End If
End Sub

However this will not prevent users from pasting data copied from outside excel .. You could clear the windows clipboard as well by using the ClearClipBoard API function but that in my opinion is bad coding .. Plus the user can still override the validation by using the AutoFill or Drag and Drop functionalities

One workaround is to always have the sheet protected and the cell locked and only unlock the cell if the user enters the data from the dropdon list and relock the cell back after the data is entered.. Which excel/windows versions are you using ?

 

[martinllawrence]

Hi. Thanks for the response I shall give that a try. This is being written for a speadsheet in Excel 2010. The worksheet is protected as I have multiple lookup formulae that use the data selected by the validation dropdown, which is why it is important to stop users from typing in or pasting data from elsewhere.

 

[Jaafar Tribak]

This is an adaptation of some code I wrote some time ago ... basically, the code prevents typing, pasting, dragging/dropping and autofilling data into the cell with Data Validation .. Only data selected by the validation dropdown is allowed

Note that this code only works as is in 32bit systems


* Protect the sheet and leave the DV cell locked before copying the codes below

The following code assumes the Worksheet with DV is "Sheet1" and the DV Cell is "A1" .. change them as required by editing the DValidationSheet and DValidationCell Constantes located at the top of the ThisWorkbook module code:

1- In the workbook module:

Option Explicit

Private Const DValidationSheet As String = "Sheet1"
Private Const DValidationCell As String = "A1"

Private Sub Workbook_Open()
    If ActiveCell.Address = Worksheets(DValidationSheet).Range(DValidationCell).Address Then _
    Call StartWatching(Worksheets(DValidationSheet))
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh Is Worksheets(DValidationSheet) And _
        Target.Address = Worksheets(DValidationSheet).Range(DValidationCell).Address Then
        Call StartWatching(Sh)
    Else
        Call StopWatching
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
      Call StopWatching
End Sub

2- In a Standard Module :

Option Explicit
 
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
 
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Public Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
 
Private Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
 
Private Declare Function SetProp Lib "user32" Alias "SetPropA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long

Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long

Private Declare Function GetProp Lib "user32" Alias "GetPropA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
 
Private Const WH_CBT As Long = 5
Private Const HCBT_CREATEWND  As Long = 3
Private Const HCBT_DESTROYWND  As Long = 4
 
 
'====================
'Public Routines.
'=====================
Public Sub StartWatching(ByVal Sh As Worksheet)
    If GetProp(Application.hwnd, "hookHandle") Then Exit Sub
    Names.Add "DV_Sheet", Sh.Name
    SetProp Application.hwnd, "hookHandle", _
    SetWindowsHookEx(WH_CBT, AddressOf CBTProc, 0, GetCurrentThreadId)
End Sub
 
Public Sub StopWatching()
    On Error Resume Next
    UnhookWindowsHookEx GetProp(Application.hwnd, "hookHandle")
    RemoveProp Application.hwnd, "hookHandle"
    Names("DV_Sheet").Delete
End Sub
 
'====================
'Private Routines.
'=====================
Private Function CBTProc _
    (ByVal idHook As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    
    Select Case idHook
        '/Was a window created ?
        Case Is = HCBT_CREATEWND
            If IsXlValDropDown(wParam) Then
                If Worksheets([DV_Sheet]).ProtectContents Then
                    Worksheets([DV_Sheet]).Unprotect
                    Application.Cursor = xlDefault
                End If
            End If
        Case HCBT_DESTROYWND
        '/Was a window destroyed ?
            If IsXlValDropDown(wParam) Then
                If Worksheets([DV_Sheet]).ProtectContents = False Then
                    Application.OnTime Now, "ProtectSheet"
                End If
            End If
    End Select
    CBTProc = CallNextHookEx _
    (GetProp(Application.hwnd, "hookHandle"), idHook, ByVal wParam, ByVal lParam)
End Function
 
Private Function IsXlValDropDown(ByVal hwnd As Long) As Boolean
    Dim sBuffer As String
    Dim lRetVal As Long
    sBuffer = Space(256)
    lRetVal = GetClassName(hwnd, sBuffer, 256)
    IsXlValDropDown = Left(sBuffer, lRetVal) = "EXCEL:"
End Function

Private Sub ProtectSheet()
    Worksheets([DV_Sheet]).Protect
End Sub

 

[Jaafar Tribak]

Oops, I forgot about the worksheet password ... If you have the worksheet protected with a password then you will need to edit the following lines : (changes in red)

1- in the CBTProc function:

Worksheets([DV_Sheet]).Unprotect [COLOR=#ff0000][B]"your_password_here"[/B][/COLOR]

2- in the ProtectSheet Sub :

Worksheets([DV_Sheet]).Protect [COLOR=#ff0000][B]"your_password_here"[/B][/COLOR]

 

[martinllawrence]

Jaafar, many thanks for the code, above. I have attempted to copy it into my spreadsheet, taking out the unnecessary underscores, but when I try to update the spreadsheet, by amending the worksheet, I keep getting an "Out of Range" error message.

What am I doing wrong?

Martin

 

[Jaafar Tribak]

How many cells with validation do you have and in hwo many sheets ? Also, which version of windows are you using ?
You can upload a copy of your workbook onto a file sharing website (like Dropbox.net) and paste the link here so I can look at it

 

[martinllawrence]

The version of Excel I am currently using is Excel 2013 .

Total number of Validation celled is 64, which I guess is where the problem lies, if I understand you comment.

Unfortunately I am unable to upload the Workbook, as it has Confidential information contained within it.

 

[Krulle1000]

Hello,

I've found a rather simple method for this:

Dim rng, ValidationRange As Range

Set rng = Sheet2.Range("B7:F1008")
Set ValidationRange = Application.Intersect(Target, rng)
temp = Target.Address '-> Target range
temp1 = .Address '-> Validation range

If Not ValidationRange Is Nothing Then
With ValidationRange
If Not .HasFormula Then
'deleted cells will get the default value "--Select--"
'cell 1008 is locked and always "", by this the variable lastrow becomes never empty, otherwise an error is trapped
lastrow = rng.Cells.Find("", SearchOrder:=xlByRows, SearchDirection:=xlNext).Row – 1
If lastrow <> 1007 Then
.Value = "--Select---“
Else
'My validation range is known, you can also search up the validation range by Excel ->
'Set rng = Cells.SpecialCells(xlCellTypeAllValidation)
'Next code will allow a copy/paste of data into the validation cells but will verify if the pasted data matches the validation,
'if not the cell will gets it's default value "--Select--"
For Each cell In ValidationRange
If Not cell.Validation.Value = True Then
cell.Value = "--Select--"
End If
Next cell
End If
End If
End With
End If


good luck