TextBox validation code adjustment needed

[kelly mort]

This code was written for me by one of the gurus here way back. It's working great just that there is some behavior of it that I wish I could improve upon it.

When I want to edit already keyed data in the textbox , the cursor jumps to the last character in the TextBox.

For example if I have "NICE BOOK" inside the TextBox, except I place the cursor in front of the "K", the cursor will always jump to be in front of the "K" when I try editing behind the K.

I want it to stay as I edit just like making corrections in a text editor.

How do I get it to do what I want?

Private Sub freg2_Change()
    Static LastText$
    Static SecondTime As Boolean
    If Not SecondTime Then
        With freg2
            If .Text Like "*[!A-Za-z. -1-5]*" Or .Text Like "*..*" Or _
                .Text Like "*--*" Or .Text Like "*  *" Or .Text Like "*-.*" Or _
                .Text Like "* .*" Or .Text Like "[. -]" Or .Text Like "[1-5]" Then
                Call Beep
                SecondTime = True
                .Text = LastText
            Else
                LastText = .Text
            End If
            For i = 1 To Len(.Text) - 1
                If Mid(.Text, i, 2) Like ".[A-Za-z1-5]" Then
                    .Text = Application.Replace(.Text, i + 1, 0, " ")
                End If
            Next i
            .Text = Replace(Replace(Replace(.Text, " - ", "-"), "- ", "-"), " -", "-")
        End With
    End If
    SecondTime = False
End Sub

Thanks in advance.

 

[kelly mort]

Bump:
I still need help with this please.

If my memories are right, I got help from @Rick Rothstein , @DanteAmor in arriving at the above code some time ago.

Let me try and explain what the above code is doing or was intended to do:

>>>>>>>>>>>>>>>
(A). Current code:
>>>>>>>>>>>>>>>
1. Avoid beginning entries with (space, dot/point/full stop, dash/hyphen, etc as in the code)
2. Prevent pasting into the textbox.
3. Prevent side by side occurring of certain characters eg "--", "..", "-." etc.

>>>>>>>>>>>>>>>>>>>>
(B). Adjustment needed:
>>>>>>>>>>>>>>>>>>>>
1. I want to be able to edit within the entered string (s) without the cursor jumping to the last position as described in the original post (post #1) above.

 

[GWteB]

As the number of validity requirements increases, it becomes more difficult to make foolproof code. So your wishes tend towards the unattainable ...
I think the code below is close to what you want but please don't be surprised if unexpected things happen sometimes.

I would therefore recommend that you change your approach. Initially, with or without minor restrictions, allow all user input and check for validity but leave the correction of invalid input to the user. For example, give the background of the concerned text box a different color and disable the OK / Apply button so it cannot be pressed. The moment the input is marked as valid, the text box can regain its original background color and the OK / Apply button can be enabled again. In addition to the foregoing, you might consider introducing a label on which you provide additional information to the user during data entry. The user then immediately knows where he/she stands and what is expected of him/her. This is generally less irritating than jumping cursors or keys that don't seem to work. Most importantly might be that this is much easier to code.

Option Explicit

Private Type TLocals
    PreviousText     As String
    BackupText       As String
    LastCursorPos    As Long
    CurrentCursorPos As Long
    NewCursorPos     As Long
    CharCount        As Long
    freg2SecondRun   As Boolean
End Type
Private this As TLocals


Private Function IsNotAllowed(ByVal argTxt As String) As Boolean
    IsNotAllowed = argTxt Like "*[!A-Za-z. -1-5]*" Or _
                   argTxt Like "*..*" Or _
                   argTxt Like "*--*" Or _
                   argTxt Like "*  *" Or _
                   argTxt Like "*-.*" Or _
                   argTxt Like "* .*" Or _
                   argTxt Like "[. -]" Or _
                   argTxt Like "[1-5]" Or _
                   VBA.Left$(argTxt, 1) = " "
End Function


Private Function AdjustOnHyphen(ByVal argFinalTxt As String, ByVal argHyphen As String) As String
    Dim Pos As Long
    Pos = VBA.InStr(1, argFinalTxt, argHyphen)
    If Pos > 0 Then
        If Pos <= this.CurrentCursorPos Then
            this.NewCursorPos = this.LastCursorPos
        End If
        AdjustOnHyphen = this.BackupText
    Else
        AdjustOnHyphen = argFinalTxt
    End If
End Function


Private Sub freg2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    this.LastCursorPos = Me.freg2.SelStart
End Sub


Private Sub freg2_Change()

    Dim FinalTxt As String, i As Long

    If Not this.freg2SecondRun Then
        With Me.freg2
            this.BackupText = this.PreviousText
            this.CurrentCursorPos = .SelStart
            this.CharCount = .SelStart - this.LastCursorPos

            If Not this.CharCount > 1 Then

                ' 1st check
                If IsNotAllowed(.Text) Then
                    VBA.Beep
                    this.NewCursorPos = this.LastCursorPos
                Else
                    this.PreviousText = .Text
                    this.NewCursorPos = this.CurrentCursorPos
                End If
                FinalTxt = this.PreviousText
                ' 2nd check
                For i = 1 To VBA.Len(FinalTxt) - 1
                    If VBA.Mid$(FinalTxt, i, 2) Like ".[A-Za-z1-5]" Then
                        FinalTxt = Application.Replace(FinalTxt, i + 1, 0, " ")
                        this.NewCursorPos = this.NewCursorPos + 1
                        Exit For
                    End If
                Next i
                ' 3rd check
                FinalTxt = AdjustOnHyphen(FinalTxt, "- ")
                FinalTxt = AdjustOnHyphen(FinalTxt, " -")

            Else
                ' ignore pasted strings with Len > 1
                FinalTxt = this.PreviousText
                this.NewCursorPos = this.LastCursorPos
            End If

            this.freg2SecondRun = True
            .Text = FinalTxt
            .SelStart = this.NewCursorPos

            this.PreviousText = FinalTxt
            this.LastCursorPos = this.NewCursorPos
        End With
    End If
    this.freg2SecondRun = False
End Sub

 

[kelly mort]

Okay I will run the test and give you feedback shortly.

I am not with my pc at the moment. I am sure all the scripts will be inside the userform module, right?

 

[GWteB]

I am sure all the scripts will be inside the userform module, right?

Your assumption is correct.

 

[kelly mort]

I am done with the test and it's working very fine and smooth.
I am very grateful.

And thanks for the PRO tips.

 

[GWteB]

You are welcome and thanks for the feedback

 

[Rick Rothstein]

Just so you know, the original code you posted was not complete which is why your cursor jumped. You omitted a global variable and two other event procedures from whatever post of mine you originally took the code from. Make a copy of your workbook and do this on the copy... remove all the code you have in the UserForm module and replace it with all of the following (I adjusted my original code for your test and textbox name). I did not test it myself but if your original code worked (except for the jumping cursor) then this should also work.

Dim LastPosition As Long

Private Sub freg2_Change()
  Static LastText As String
  Static SecondTime As Boolean
  If Not SecondTime Then
    With freg2
      If .Text Like "*[!A-Za-z. -1-5]*" Or .Text Like "*..*" Or _
                .Text Like "*--*" Or .Text Like "*  *" Or .Text Like "*-.*" Or _
                .Text Like "* .*" Or .Text Like "[. -]" Or .Text Like "[1-5]" Then
        Beep
        SecondTime = True
        .Text = LastText
        .SelStart = LastPosition
      Else
        LastText = .Text
      End If
      For i = 1 To Len(.Text) - 1
          If Mid(.Text, i, 2) Like ".[A-Za-z1-5]" Then
              .Text = Application.Replace(.Text, i + 1, 0, " ")
          End If
      Next i
      .Text = Replace(Replace(.Text, "- ", "-"), " -", "-")
    End With
  End If
  SecondTime = False
End Sub

Private Sub freg2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  With freg2
    LastPosition = .SelStart
    'Place any other MouseDown event code here
  End With
End Sub

Private Sub freg2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  With freg2
    LastPosition = .SelStart
    'Place any other KeyPress checking code here
  End With
End Sub

 

[kelly mort]

Oh okay.

I will test it and get back to you.

 

[kelly mort]

Hello @Rick Rothstein
I am still having the same issue though I am using the exact same code you posted recently.