Excel Macro To Prevent Paste If Cell Contains A Data Validation

Hello,

Hoping someone can provide some coding assistance.  I'm trying to use the following code to prevent an end-user from pasting data into a cell if there is a data validation range listed and its not working.  Can someone review and let me know where the problem is at?

Ive created a named range titled: ValidationRange which is looking at the target cell ($AB$4).  So if that cell has a validation range then the end user would get an error message stating:  Your last operation was canceled.  It would have deleted data validation rules.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Does the validation range still have validation?
    If HasValidation(Range("ValidationRange")) Then
        Exit Sub
    Else
        Application.Undo
        MsgBox "Your last operation was canceled." & _
        "It would have deleted data validation rules.", vbCritical
    End If
End Sub

Private Function HasValidation(r) As Boolean
'   Returns True if every cell in Range r uses Data Validation
    On Error Resume Next
    x = r.Validation.Type
    If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function


Thanks!!!!!
LVL 1
EscanabaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
Hi,

in your code you get a message if

HasValidation(Range("ValidationRange"))  is false, I thought you would do it when true

Regards
0
EscanabaAuthor Commented:
Im not seeing it.  Sorry Im not good with VB coding.  How do you recommend rewritting it?
0
Martin LissOlder than dirtCommented:
Here is all you need. Note that the HasValidation procedure was removed, corrected, and incorporated into the Change event.


Option Explicit
' This goes at the top of the sheet's code page
Public bUndo As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x
    If bUndo Then
        bUndo = False
        Exit Sub
    End If
    
    'Does the validation range still have validation?
    If Not Intersect(ActiveCell, Range(ValidationRange)) Is Nothing Then
        On Error Resume Next
        x = Target.Validation.Type
        On Error GoTo 0
        If Err.Number = 0 Then
            bUndo = True
            Application.Undo
            MsgBox "Your last operation was canceled." & _
            "It would have deleted data validation rules.", vbCritical
        Else
            Exit Sub
        End If
    End If
End Sub

Open in new window

0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

EscanabaAuthor Commented:
Im getting an error.  Please see attached sample file.  Cells AB4 & AB5.  If I try to paste whats in cell AB5 to AB4 the error appears which instead it should show the protect message from the code.
EE2M.xlsm
0
Martin LissOlder than dirtCommented:
You have AB4 as a named range but there's no Data Validation in that cell.
0
EscanabaAuthor Commented:
Sample attached.  DV added to cell AB4 and AB5.  When I attempt to paste something in AB4 the same error appears.
EE2M.xlsm
0
Martin LissOlder than dirtCommented:
I'm sorry that was my mistake. When I was testing I was using a different range. When I pasted the code above it still had that name and when I manually changed it to  "ValidationRange" I incorrectly removed the needed quotes.

In your workbook, ValidationRange refers only to AB4. Is that what you want?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x
    If bUndo Then
        bUndo = False
        Exit Sub
    End If
    
    'Does the validation range still have validation?
    If Not Intersect(ActiveCell, Range("ValidationRange")) Is Nothing Then
        On Error Resume Next
        x = Target.Validation.Type
        On Error GoTo 0
        If Err.Number = 0 Then
            bUndo = True
            Application.Undo
            MsgBox "Your last operation was canceled." & _
            "It would have deleted data validation rules.", vbCritical
        Else
            Exit Sub
        End If
    End If
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
EscanabaAuthor Commented:
That got it.  Thanks for your help!!
0
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

Marty - MVP 2009 to 2013
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.