VBA for data validating - copy and paste data

[wilnning]

Dear Gurus’,

i understand the data validation does not work on copy and paste data and vba is the only way to overcome this.

I really need some help on vba as I am really a noob on this. Greatly appreciate the help in advance.

Issues: data validation not working on copy and paste data

Affected cells: cell D2:D20000

Data validation rule: only limit to 4 character only

Vba rules: check cell D2:D20000 for 4 character limit, allow non affected data to be pasted and prevent affected data to be pasted and leave the cells blank.

Sorry, i tried to upload the mini-sheet but couldnt after install the XL2BB add on in excel.

Thank you

 

[kvsrinivasamurthy]

Ref Post #9.I have already given information. Code does not allow pasting of data directly as it nullifies the validation in cell.
But code allows only paste values. Right click and use Paste Special -->> Values. Here also only length of maximum of 4 allowed.

 

[wilnning]

Dear bebo021999,

Thanks for the advice. I have tested this out and it eliminate more data than needed.

Rightfully, if Column D data inputted is four character, the whole row of data should be intact. Whole row data should disappear for entries whose Column D is not four character.

But all data will disappear in other columns except those cells that are four characters

Wish for your advice.

 

[wilnning]

Ref Post #9.I have already given information. Code does not allow pasting of data directly as it nullifies the validation in cell.
But code allows only paste values. Right click and use Paste Special -->> Values. Here also only length of maximum of 4 allowed.

Dear kvsrinivasamurthy,​

Yes. I have also tested by right click and use paste special as values. Data is still removed automatically despite it's four character in Column D.

Thank you.

 

[bebo021999]

Try again:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range, rng As Range, cellb As Range
Set rng = Intersect(Target, Range("D2:D20000"))
If rng Is Nothing Then Exit Sub
For Each cell In rng
    If Len(cell) <> 4 Then
        Application.EnableEvents = False
        For Each cellb In Target
            If cellb.Row = cell.Row Then cellb.ClearContents
        Next
        Application.EnableEvents = True
    End If
Next
End Sub

 

[kvsrinivasamurthy]

Is it possible to upload sample file. because I have no problem.

 

[wilnning]

Try again:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range, rng As Range, cellb As Range
Set rng = Intersect(Target, Range("D2:D20000"))
If rng Is Nothing Then Exit Sub
For Each cell In rng
    If Len(cell) <> 4 Then
        Application.EnableEvents = False
        For Each cellb In Target
            If cellb.Row = cell.Row Then cellb.ClearContents
        Next
        Application.EnableEvents = True
    End If
Next
End Sub

Dear bebo021999,

Thanks for your kind support and advice, the code works but it seems like the affected row data is disappearing slowly if a large number of rows is copied and pasted. the file freezes and hang. Therefore it will render the file unusable.

Is there a way to change the code so that

(1) in the event, that any of the data copied and pasted containing <> 4 characters, all data will be prevented pasting over?
(2) Then a message box is prompted out "At least one entries in Column D contains <>4 characters. Hence data cannot be pasted, please check data again!"

Thanks so much for the great help.

 

[kvsrinivasamurthy]

Try this code. I tested in the file. Only few cells are validated in D column. but range shown as D2;D20000. Modified code.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D2:D20000").SpecialCells(xlCellTypeAllValidation)) Is Nothing Then
Dim Y
Application.EnableEvents = False
On Error Resume Next
Y = 0
Y = Target.Validation.Type
If Y = 0 Then
    MsgBox "Cell is validated. Hence use only Paste Special - Values."
    Application.Undo
Else
    If Len(Target) <> 4 And Len(Target) <> 0 Then
    MsgBox "Cell is validated to Max length 4 characters. Hence use only 4 characters."
    Application.Undo
    End If
End If
Application.EnableEvents = True
End If
End Sub

 

[wilnning]

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("D2:D20000").SpecialCells(xlCellTypeAllValidation)) Is Nothing Then Dim Y Application.EnableEvents = False On Error Resume Next Y = 0 Y = Target.Validation.Type If Y = 0 Then MsgBox "Cell is validated. Hence use only Paste Special - Values." Application.Undo Else If Len(Target) <> 4 And Len(Target) <> 0 Then MsgBox "Cell is validated to Max length 4 characters. Hence use only 4 characters." Application.Undo End If End If Application.EnableEvents = True End If End Sub

Dear kvsrinivasamurthy,

Thanks for the modified code. i have tested on the same file in dropbox. It's the same - Data is still removed automatically despite it's four characters in Column D.

 

[kvsrinivasamurthy]

I have changed code. Do not use the file that you have uploaded. I have not done any change in that file. Use your original file. Copy this code to that file.

Dim R As Range
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, R) Is Nothing Then
Dim Y
Application.EnableEvents = False
On Error Resume Next
Y = 0
Y = Target.Validation.Type
If Y = 0 Then
    MsgBox "Cell is validated. Hence use only Paste Special - Values."
    Application.Undo
Else
    If Len(Target) <> 4 And Len(Target) <> 0 Then
    MsgBox "Cell is validated to Max length 4 characters. Hence use only 4 characters."
    Application.Undo
    End If
End If
Application.EnableEvents = True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set R = Cells.SpecialCells(xlCellTypeAllValidation)
End Sub

 

[wilnning]

Dear kvsrinivasamurthy,

Thanks for the new codes. I have tested out in my own file as mentioned. There will still be a message box, prompting to use Paste Special - Values despite i did use paste special as values. See below;