The fifth Digit of text must be Zero (0)

SamarthSalunkhe

Board Regular
Joined
Jun 14, 2021
Messages
103
Office Version
  1. 2016
Platform
  1. Windows
Hi All,

I'm using the below code to prevent some characters from Keypress and copying past in User Form, it is working smoothly but suddenly I realise that it is not fulfilling my one requirement.

My requirement is Fifth Digit of text must be Zero (0), I have prevented it from keypress but I want code to prevent it from copying past.

can someone help me with this?


VBA Code:
Private Sub txtIFSC_Change()

Dim LastPosition As Long

Const PatternFilter As String = "*[!0-9A-Z]*"

  Static LastText As String
  Static SecondTime As Boolean
  If Not SecondTime Then
    With txtIFSC
     If .Text Like PatternFilter Then
        MsgBox "Special Character and Small Alphabet are not allowed in this tab", vbExclamation, "Invalid Character Found"
        SecondTime = True
        .Text = LastText
        .SelStart = LastPosition
      Else
        LastText = .Text
      End If
    End With
  End If
  SecondTime = False
  
End Sub

Private Sub txtIFSC_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Dim LastPosition As Long

Const PatternFilter As String = "*[!0-9A-Z]*"
  
  With txtIFSC
    LastPosition = .SelStart
    
  End With
End Sub

Private Sub txtIFSC_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

Dim LastPosition As Long

Const PatternFilter As String = "*[!0-9A-Z]*"
    
    With txtIFSC
    LastPosition = .SelStart
 
 Select Case Len(Me.txtIFSC.Text)
    
    Case 4
        If (KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8 Then
            KeyAscii = KeyAscii
        Else
            KeyAscii = 0
            MsgBox "Fift Digit of {IFSC Code} Must be Zero", vbExclamation, "Incorrect IFSC Code"
            
        End If
 End Select
 
 Select Case KeyAscii

 Case Asc("0") To Asc("9")
 Case Asc("A") To Asc("Z")
 
 Case Else

 KeyAscii = 0
 MsgBox "Special Character and Small Alphabet are not allowed in this tab", vbExclamation, "Invalid Character Found"

 End Select
 End With
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
My suggestion is that you do all of your checks within the Sub txtIFSC_Change. For example with this code:
VBA Code:
Dim NoCheck As Boolean     'PUT THIS ON TOP of the Module

Private Sub txtIFSC_Change()
Dim CkCrt As String, cTxt As String, nTxt As String


If NoCheck = False Then
Me.txtIFSC.ControlTipText = "Only numbers and UCase characters"
    'Create a string with the approved characters
    CkCrt = Approved("A|Z", CkCrt)      'A to Z
    CkCrt = Approved("0|9", CkCrt)      '0 to 9
    CkCrt = Approved("+-=", CkCrt)      'specific characters
'
    cTxt = Me.txtIFSC.Text
    For I = 1 To Len(cTxt)
        If InStr(1, CkCrt, Mid(cTxt, I, 1), vbBinaryCompare) > 0 Then
            nTxt = nTxt & Mid(cTxt, I, 1)
        Else
            beep
        End If
    Next I
    NoCheck = True
    Me.txtIFSC.Text = nTxt
    NoCheck = False
    If Mid(nTxt, 5, 1) <> "0" And Len(nTxt) >= 5 Then
        Me.txtIFSC.SelStart = 4
        Me.txtIFSC.SelLength = 1
        MsgBox ("Fifth character should be Zero (0); please correct")
    End If
End If
End Sub

Function Approved(ByVal aString As String, ByRef aWord As String) As String
Dim aInd As Long
'
If InStr(1, aString, "|", vbTextCompare) > 0 Then
    For I = Asc(Left(aString, 1)) To Asc(Right(aString, 1))
        aWord = aWord & Chr(I)
    Next I
Else
    aWord = aWord & aString
End If
Approved = aWord
End Function

Note the first DIM shoud be inserted at the top of the vba module

In this way, when the txtbox get any change:
-a string with all the approved character is created (the several CkCrt = Approved at the beginning of the code)
-each character in the txtbox text is cheched against the approved string
-unallowed characters are removed with a beep
-the fifth character is cheched to be 0, or a messagebox will apper suggesting to modify the string

Of course this approach has a little redundancy during normal character-by-character compilation, but this will not overheath your cpu

Bye
 
Upvote 0

Forum statistics

Threads
1,215,054
Messages
6,122,895
Members
449,097
Latest member
dbomb1414

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top