DOC Office Consulting

I have created a data validation rule that checks new entries to ensure they haven’t already been recorded, but when a user pastes into this worksheet, the data validation doesn’t work. How can I prevent people using paste to circumvent my data validation?

Unfortunately when cells are pasted over in Excel, it’s not just the data that’s pasted, it’s the formatting, the number formatting, the conditional formatting, the comments and it’s the data validation rules. Everything about the source cell replaces everything about the destination cell.
This can make the data validation somewhat redundant when a user can simply paste over it and remove the checks and balances you so carefully built.

So whilst Excel doesn’t account for this, you can achieve most things in Excel with a bit of clever coding.
I’d recommend creating a macro that runs on worksheet change event that:

1. Gets the last action from the undo stack to check for paste
2. Undoes and Redoes the paste with values only to ensure existing validation and formatting is not pasted over

this will ensure data validation and existing formatting rules are maintained

3. Loops through all cells in the first column of the pasted range and tests for duplicates in all existing records (in rows above)
4. Tests the remaining cells in the same row where a first column match is found
5. Deletes duplicate rows & displays a message advising which records have been deleted

This will remove the duplicate items

To view a working example:

• Download the example workbook here
• Open the workbook
• Enable the macros
• Click ALT+F11 to display the Visual Basic Editor
• Double Click on the ‘Sheet1 (Validated Data)’ in the Project Explorer window

To create the code within your existing workbook:

• Open the workbook
• Enable the macros
• Click ALT+F11 to display the Visual Basic Editor
• Double Click on the sheet that contains the validation in the Project Explorer window
• Enter the below code in the code window

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pAction As String, pRng As Range, c As Range, r As Range, dRng As Range, tmpstr As String, eMsg As String, a As Integer

‘Turn off events to ensure this doesn’t loop on re-pasting
Application.EnableEvents = False

‘Get last action from undo stack to check for paste in column 1
pAction = GetUndo
If Left(UCase(Trim(pAction)), 5) = “PASTE” Then
If Target.Cells(1, 1).Column > 1 Then GoTo lbEnd

‘Redo paste with values only to ensure validation and formatting is not pasted over
Application.Undo
Set pRng = Target
pRng.PasteSpecial xlPasteValues

‘Loop through first column of pasted range and test for duplicates in all records above
For Each c In pRng.Resize(pRng.Rows.Count, 1)
tmpstr = UCase(Trim(c.Value))
Set r = c.Offset(1 – c.Row, 0)
Do Until r.Row = c.Row
If UCase(Trim(r.Value)) = tmpstr Then

‘Test all columns in row for match, skip if different
‘Delete this section if only the first column is to be tested
For a = 1 To pRng.Columns.Count – 1
If Trim(UCase(r.Offset(0, a).Value)) <> Trim(UCase(c.Offset(0, a).Value)) Then GoTo lbNextRow
Next a

‘Create range of records to be deleted from pasted duplicates & add value to message
If dRng Is Nothing Then
Set dRng = c
Else
Set dRng = Application.Union(dRng, c)
End If
eMsg = eMsg & Chr(10) & r.Value
GoTo lbSkipLoop
End If
lbNextRow:
Set r = r.Offset(1, 0)
Loop
lbSkipLoop:
Next c

‘Delete duplicates & display message advising which records have been deleted
If Not dRng Is Nothing Then
dRng.EntireRow.Delete
MsgBox “Process has removed the following duplicated records” & Chr(10) & eMsg
End If
End If

‘Turn events back on
lbEnd:
Application.EnableEvents = True
End Sub

‘Create a function that returns the last item in the Undo stack as string
Function GetUndo() As String
On Error Resume Next
GetUndo = Application.CommandBars(“Standard”).Controls(“&Undo”).List(1)
End Function

Cheers,