Prevent the recurrence of characters

Hi
how i can to Prevent the recurrence of characters on textbox
?????????
thaaaaaaaaaaaaaaaaaaaanks you

Quote:

---

recurrence of characters

---

How would you define "Count of Recurrance" Maximum 2 Chars?

For example

Purr and not Purrr

then try this

Code:

---

Dim Strg2Check As String
Private Sub Text1_KeyPress(KeyAscii As Integer)
    '~~> Check for max 2 occurance
    Strg2Check = Chr(KeyAscii) & Chr(KeyAscii)
   
    '~~> Ensure it is applicable to only A-Z and a-z
    If Right(Text1, 2) = Strg2Check And _
    (KeyAscii > 96 And KeyAscii < 123) Or _
    (KeyAscii > 65 And KeyAscii < 91) Then
        KeyAscii = 0
    End If
End Sub

---

Edit: If you want it to be applicable for everything then remove " (KeyAscii > 96 And KeyAscii < 123) Or (KeyAscii > 65 And KeyAscii < 91) " part. If you want to restrict some other characters like "?" then check the code below....

Code:

---

Dim Strg2Check As String
Private Sub Text1_KeyPress(KeyAscii As Integer)
    '~~> Check for max 2 occurance
    Strg2Check = Chr(KeyAscii) & Chr(KeyAscii)
   
    '~~> Ensure it is applicable to only "?"
    If Right(Text1, 2) = Strg2Check And _
    KeyAscii = 63 Then
        KeyAscii = 0
    End If
End Sub

---

For any other restrictions refer to the Ascii table in my signature for the key codes...

Hope this helps...

Here's another way.

Code:

---

Option Explicit
Private mcolChars As New Collection
Private Sub Text1_KeyPress(KeyAscii As Integer)

    On Error Resume Next
    mcolChars.Add KeyAscii, Str(KeyAscii)
    If Err.Number = 457 Then
        KeyAscii = 0
    End If
   
End Sub

---

Nice One Martin :)

Just a quick question... if I want to allow a min of two occurances then how do I use the above? for example koolsid

Enumerate the occurences in some way. For example:

1) Identify character to be added. Let's say it's J.
2) Slap enum 1 on it. J becomes J1.
3) Try to add to collection. If it works, not a dup.
4) If it fails, loop through all enumerated occurences.

So if you wanted to allow up to 2 occurences, in the above example you'd try to add J1, and then J2 if it failed. For 37 occurences, your loop would try to add J1 though J37 until it succeeded. Or ultimately failed, in which case you would disallow this J because you're full up.

I thought that I had already posted the allow-two answer. In any case here it is.

Code:

---

Option Explicit
Private mcolChars As New Collection
Private mcolAllow As New Collection

Private Sub Text1_KeyPress(KeyAscii As Integer)

    On Error Resume Next
   
    mcolChars.Add KeyAscii, Str(KeyAscii)
    If Err.Number = 457 Then
        If MoreThanTwo(KeyAscii) Then
            KeyAscii = 0
        End If
    End If
   
End Sub
Public Function MoreThanTwo(KA As Integer) As Boolean

    On Error Resume Next
   
    MoreThanTwo = False
    mcolAllow.Add KA, Str(KA)
    If Err.Number = 457 Then
        MoreThanTwo = True
    End If
   
End Function

---

Quote:

---

Originally Posted by Ellis Dee

Enumerate the occurences in some way. For example:

1) Identify character to be added. Let's say it's J.
2) Slap enum 1 on it. J becomes J1.
3) Try to add to collection. If it works, not a dup.
4) If it fails, loop through all enumerated occurences.

So if you wanted to allow up to 2 occurences, in the above example you'd try to add J1, and then J2 if it failed. For 37 occurences, your loop would try to add J1 though J37 until it succeeded. Or ultimately failed, in which case you would disallow this J because you're full up.

---

I thought about that approach but it has some problems because there are of course KeyAscii values that end in 1 and 2 so you have to do something like 99|1 and then split at the "1" when examiming the keys which would be pretty slow.

I take that back.

Code:

---

Option Explicit
Private mcolChars As New Collection

Private Sub Text1_KeyPress(KeyAscii As Integer)

    On Error Resume Next
   
    mcolChars.Add KeyAscii, Str(KeyAscii) & "|1"
    If Err.Number = 457 Then
        If MoreThanTwo(KeyAscii) Then
            KeyAscii = 0
        End If
    End If
   
End Sub

Public Function MoreThanTwo(KA As Integer) As Boolean

    On Error Resume Next
   
    MoreThanTwo = False
    mcolChars.Add KA, Str(KA) & "|2"
    If Err.Number = 457 Then
        MoreThanTwo = True
    End If
   
End Function

---

I was thinking of a more generic approach. For example, the following will allow 3 of any character:

Code:

---

Option Explicit

Private Const DupsAllowed = 3
Private mcolChars As New Collection

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If TooManyDups(KeyAscii) Then KeyAscii = 0
End Sub

Private Function TooManyDups(KeyAscii As Integer) As Boolean
On Error Resume Next
    Dim i As Long
   
    For i = 1 To DupsAllowed
        mcolChars.Add KeyAscii & "|" & i
        If Err.Number = 0 Then Exit Function
    Next
    TooManyDups = True
End Function

---

And this is a different version of Ellis Dee's solution, using array vs collection

Code:

---

Option Explicit

Private Const DupsAllowed = 3
Private asciiTable(0 To 255) As Byte

Private Sub Text1_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
  ' some keys should be allowed to flow thru always?
  ' add additional ones as needed
  Case vbKeyBack, vbKeyDelete, vbKeyEnter, vbKeyTab
  Case Else
        If asciiTable(KeyAscii) = DupsAllowed Then
            KeyAscii = 0
        Else
            asciiTable(KeyAscii) = asciiTable(KeyAscii) + 1
        End If
  End Select
End Sub

---

edited. Depending on how the OP wants to pursue, other considerations should be done
1. What if backspace or delete is hit? Shouldn't the count decrement on the character being deleted
2. What if a range of characters are selected & then replaced/deleted?
3. What if text is pasted?
4. What happens when .Text = "" is performed? The array/collection should be reset.

I am still not sure what the OP wants to achieve. I think he wants to stop a key to accidentally hold down to cause a character repeatedly entered. If that then it is different story.

Following your posts, to prevent a character appears more than, say, 2 times in a textbox, we may have a much simpler solution:

Code:

---

Private Sub Text1_KeyPress(KeyAscii As Integer)
  Const MaxDup = 2
  If Len(Text1.Text) - Len(Replace(Text1.Text, Chr$(KeyAscii), "")) >= MaxDup Then
      KeyAscii = 0
  End If
End Sub

---

Quote:

---

Originally Posted by anhn

I am still not sure what the OP wants to achieve. I think he wants to stop a key to accidentally hold down to cause a character repeatedly entered. If that then it is different story.

Following your posts, to prevent a character appears more than, say, 2 times in a textbox, we may have a much simpler solution:

Code:

---

Private Sub Text1_KeyPress(KeyAscii As Integer)
  Const MaxDup = 2
  If Len(Text1.Text) - Len(Replace(Text1.Text, Chr$(KeyAscii), "")) >= MaxDup Then
      KeyAscii = 0
  End If
End Sub

---

---

:thumb: