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

 

[hajiali]

Try this code in the Sheet code. Right-click on the sheet name at the bottom of the workbook, click on View Code paste the below code on the sheet code.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D2:D20000")) Is Nothing Then
        If Not Len(Intersect(Target, Range("D2:D20000"))) = 4 Then
            Application.EnableEvents = False
            Application.Undo
                MsgBox "ONLY 4 CHARACTER ARE ALLOWED IN THIS COLUMN", vbOKOnly, "INVALID VALUE" ' MsgBox row is Optional
            Application.EnableEvents = True
                Exit Sub
        End If
    End If
End Sub

Hope this helps

 

[hajiali]

Found an issue with code in Post #2 where leading Zeros are not allowed. below allow less than 4 digits changes the format to 4 with leading Zeros. use this code instead.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
Set rg = Range("D2:D20000")
    If Not Intersect(Target, rg) Is Nothing Then
        If Len(Intersect(Target, rg)) < 4 Then
            rg.NumberFormat = "0000"
            Exit Sub
        End If
        If Len(Intersect(Target, rg)) > 4 Then
            Application.EnableEvents = False
            Application.Undo
                MsgBox "ONLY 4 CHARACTER ARE ALLOWED IN THIS COLUMN", vbOKOnly, "INVAILD VALUE" ' MsgBox row is Optional
            Application.EnableEvents = True
                Exit Sub
        End If
    End If
End Sub

 

[wilnning]

Dear Hajiali,

Thanks so much for the great advice here. I have tested out Post#3 in the excel and have these observations below;

I tested out examples of ID such as XXX987A and 34H. An error message (attached image) prompts out, indicating an error. But those errors ID can still be pasted in it and able to save file.

Is there a way to disallows the pasting of error IDs' in the cells? This will force the users to correct them as these affected cells will be empty.

I really appreciate your help.

 

[hajiali]

If I understand correctly only Numbers are allowed in Column D. if you want to add functionally to disable text withing the ID try this

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
Set rg = Range("D2:D20000")
    If Not Intersect(Target, rg) Is Nothing Then
        If Len(Intersect(Target, rg)) < 4 And IsNumeric(rg) Then
            rg.NumberFormat = "0000"
            Exit Sub
        End If
        If Len(Intersect(Target, rg)) > 4 Or Not IsNumeric(rg) Then
            Application.EnableEvents = False
            Application.Undo
                MsgBox "ONLY 4 CHARACTER ARE ALLOWED IN THIS COLUMN", vbOKOnly, "INVAILD VALUE" ' MsgBox row is Optional
            Application.EnableEvents = True
                Exit Sub
        End If
    End If
End Sub

 

[hajiali]

sorry use this instead

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
Set rg = Range("D2:D20000")
    If Not Intersect(Target, rg) Is Nothing Then
        If Len(Intersect(Target, rg)) < 4 And IsNumeric(Intersect(Target, rg)) Then
            rg.NumberFormat = "0000"
            Exit Sub
        End If
        If Len(Intersect(Target, rg)) > 4 Or Not IsNumeric(Intersect(Target, rg)) Then
            Application.EnableEvents = False
            Application.Undo
                MsgBox "ONLY 4 CHARACTER ARE ALLOWED IN THIS COLUMN", vbOKOnly, "INVAILD VALUE" ' MsgBox row is Optional
            Application.EnableEvents = True
                Exit Sub
        End If
    End If
End Sub

 

[shinigamilight]

Give this a try

Private Sub Worksheet_Change(ByVal Target As Range)
        If Intersect(Target, Range("D2:D20000")) Is Nothing Then Exit Sub
        
                If Len(Target.Value) <> 4 Then
                    Application.EnableEvents = False
                    Application.Undo
                    MsgBox "Please enter a 4 Character string", vbExclamation, "Error"
                    Application.EnableEvents = True
                End If

End Sub

 

[kvsrinivasamurthy]

Try this worksheet event code. This code will prevent pasting Data Which removes validation of cell. It will allow Pasting only Values (Paste Special ->>Values) with maximum length of 4 characters.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D2:D20000")) 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 Then
    MsgBox "Cell is validated to Max lenghth 4 characters. Hence use only 4 characters."
    Application.Undo
    End If
End If
Application.EnableEvents = True
End If
End Sub

How to use workheet event the code
Right click on Sheet tab --> view code
Visual Basic (VB) window opens.
Paste the code
Close the VB window.
Save the file as .xlsm

 

[wilnning]

Dear Gurus's hajiali, shinigamilight & kvsrinivasamurthy,

Really fortunate to have your help and appreciate it.

Do let me clarify, Column D can accept only 4 characters which can be alphabets and starting can also be 0 or alphabets. Column D format is "text" so that 0 can be a starting value if required.

I encountered errors after copy and paste the visual codes in the excel.

The errors screenshot has been attached in this post along with an example of this visual codes are pasted in the file.

(1) For hajiali - Run-time error "13", Type mismatch
(2) For shinigamilight - Run-time error "13", Type mismatch
(3) For kvsrinivasamurthy - No run time error. But msg box will prompt out every time and do not allow data to paste even if only 4 characters is copied and paste in Column D. For example, I have tested out 1234, 0123, 453T, SP12 but file disallows pasting with msg box prompting

Wish for your kind help and advice.

 

[bebo021999]

May be:

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