Multiple Textbox with Restriction

H

hajiali

Well-known Member
Joined
Sep 8, 2018
Messages
624
Office Version
  1. 2016
Platform
  1. Windows
Hello everyone,

I have over 176 Textboxes in a userfrom that I need to restrict the value to be numerical values between 1 and 176 textboxes an be blank if a value in any of the textbox is not between those value to alert user and set that textbox as setfocus.

Textbox3 thur Textbox178 are the textboxes that need the restriction. any help is greatly appreciated.

VBA Code: 
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Not IsNumeric(TextBox3.Value) Then
        MsgBox "only numbers allowed"
        Cancel = True
    End If
End Sub

so instead doing the above 176 something better.
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
If all else fails, writing 176 _Exit subs is quick and easy if you use VBA to write them to a text file then copy and paste the results to your user form module.
Create, save and close an empty text file, I used notepad named it test.txt and saved to my C:Temp directory.
Then ran this, it doesn't have your check for the value if it is numeric but you get the idea.
VBA Code: 
Sub Write_A_Bunch_Of_Exit_Subs()

    Dim strFile_Path As String, i As Long
    
    strFile_Path = "C:\temp\test.txt"
    Open strFile_Path For Append As #1
        For i = 3 To 178
            Print #1, "Private Sub TextBox" & i & "_Exit(ByVal Cancel As MSForms.ReturnBoolean)"
            Print #1, "If Not IsNumeric(TextBox" & i & ".Value) Then"
            Print #1, "MsgBox ""only numbers allowed"""
            Print #1, "Cancel = True"
            Print #1, "End If"
            Print #1, "End Sub"
            Print #1, ""
        Next i
    Close #1
End Sub

Hope that helps.
 
Upvote 0
Solution
Thats one way to do it Never thought to do it that way.
 
Upvote 0
Had thought what you wanted would be easy using a class module, but after much googling and experimentation discovered otherwise.
Thanks for the feedback and good luck with your project.
 
Upvote 0
STEP1: Create a CLASS (for example: EventTextBox)
VBA Code: 
Option Explicit
Private m_Control As MSForms.control
Private m_oldTxt As String
Private m_bchange As Boolean
Private WithEvents txtBox As MSForms.TextBox

Property Set control(ctl As MSForms.control)
   Set m_Control = ctl
   Set txtBox = ctl
End Property

Private Sub txtBox_Change()
  'CTRL+ V  (PASTE)
 
  If m_bchange Then Exit Sub
  With txtBox
      If Not bIsNumber(.Text) And Len(.Text) > 0 Then
         Beep
         m_bchange = True
        .Text = m_oldTxt
      Else
         m_oldTxt = txtBox.Text
      End If
  End With
  m_bchange = False
End Sub

Private Function bIsNumber(s As String) As Boolean
    'LIKE OPERATOR CANNOT USE FOR ASIAN LANGUAGE
     Dim i As Long, j As Long, k As Long
     bIsNumber = False
    
     s = Trim(s)
     k = Len(s)
     If k = 0 Then Exit Function
     For i = 1 To k
         j = Asc(Mid(s, i, 1))
         If j < 48 Or j > 57 Then Exit Function
     Next
     bIsNumber = True
End Function

Private Sub txtBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'ASIAN LANGUAGE WILL NOT FIRE KEYPRESS EVENT (ONLY KEYDOW EVENT)
    fPOS txtBox
End Sub

Private Sub txtBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'ASIAN LANGUAGE (UNION CODE) WILL RETURN 229
    'ONLY MEMORY LAST TEXT FOR NON-ASIAN LANGUAGE
    If KeyCode <> 229 Then fPOS txtBox

End Sub

Private Sub txtBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'ASIAN LANGUAGE WILL NOT FIRE KEYPRESS EVENT (ONLY KEYDOW EVENT)
    If fINVAILD(KeyAscii) Then KeyAscii = 0
End Sub

Private Sub fPOS(f As MSForms.TextBox)
    m_oldTxt = f.Text
    m_bchange = False
End Sub

Private Function fINVAILD(KeyAscii As MSForms.ReturnInteger) As Boolean
    'ONLY ALLOW 0~9
    If KeyAscii < 48 Or KeyAscii > 57 Then
       fINVAILD = True
    Else
       fINVAILD = False
    End If
End Function


STEP 2: In Userform1, Insert follow code
VBA Code: 
Option Explicit

Public m_COLL As Collection
Private m_CLS As EventTextBox

Private Sub UserForm_Activate()

    Set m_COLL = New Collection

    Dim ctl As MSForms.control
    
    For Each ctl In Me.Controls
       ' Debug.Print TypeName(ctl)
      
        If TypeName(ctl) = "TextBox" Then
           If ctl.Tag = "num" Or ctl.Name = "TextBox3" Then
              'Debug.Print ctl.Name
              Set m_CLS = New EventTextBox
              Set m_CLS.control = ctl
              m_COLL.Add m_CLS
           End If
          
        End If
    Next
    
    
End Sub

You can download demo file.


https://drive.google.com/file/d/1pExHWrGY4cbWid4CSJ956-W5ftTkf7Lm/view?usp=sharing
 
Upvote 0
u5537145 said:
STEP1: Create a CLASS (for example: EventTextBox)
VBA Code: 
Option Explicit
Private m_Control As MSForms.control
Private m_oldTxt As String
Private m_bchange As Boolean
Private WithEvents txtBox As MSForms.TextBox

Property Set control(ctl As MSForms.control)
   Set m_Control = ctl
   Set txtBox = ctl
End Property

Private Sub txtBox_Change()
  'CTRL+ V  (PASTE)
 
  If m_bchange Then Exit Sub
  With txtBox
      If Not bIsNumber(.Text) And Len(.Text) > 0 Then
         Beep
         m_bchange = True
        .Text = m_oldTxt
      Else
         m_oldTxt = txtBox.Text
      End If
  End With
  m_bchange = False
End Sub

Private Function bIsNumber(s As String) As Boolean
    'LIKE OPERATOR CANNOT USE FOR ASIAN LANGUAGE
     Dim i As Long, j As Long, k As Long
     bIsNumber = False
   
     s = Trim(s)
     k = Len(s)
     If k = 0 Then Exit Function
     For i = 1 To k
         j = Asc(Mid(s, i, 1))
         If j < 48 Or j > 57 Then Exit Function
     Next
     bIsNumber = True
End Function

Private Sub txtBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'ASIAN LANGUAGE WILL NOT FIRE KEYPRESS EVENT (ONLY KEYDOW EVENT)
    fPOS txtBox
End Sub

Private Sub txtBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'ASIAN LANGUAGE (UNION CODE) WILL RETURN 229
    'ONLY MEMORY LAST TEXT FOR NON-ASIAN LANGUAGE
    If KeyCode <> 229 Then fPOS txtBox

End Sub

Private Sub txtBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'ASIAN LANGUAGE WILL NOT FIRE KEYPRESS EVENT (ONLY KEYDOW EVENT)
    If fINVAILD(KeyAscii) Then KeyAscii = 0
End Sub

Private Sub fPOS(f As MSForms.TextBox)
    m_oldTxt = f.Text
    m_bchange = False
End Sub

Private Function fINVAILD(KeyAscii As MSForms.ReturnInteger) As Boolean
    'ONLY ALLOW 0~9
    If KeyAscii < 48 Or KeyAscii > 57 Then
       fINVAILD = True
    Else
       fINVAILD = False
    End If
End Function


STEP 2: In Userform1, Insert follow code
VBA Code: 
Option Explicit

Public m_COLL As Collection
Private m_CLS As EventTextBox

Private Sub UserForm_Activate()

    Set m_COLL = New Collection

    Dim ctl As MSForms.control
   
    For Each ctl In Me.Controls
       ' Debug.Print TypeName(ctl)
     
        If TypeName(ctl) = "TextBox" Then
           If ctl.Tag = "num" Or ctl.Name = "TextBox3" Then
              'Debug.Print ctl.Name
              Set m_CLS = New EventTextBox
              Set m_CLS.control = ctl
              m_COLL.Add m_CLS
           End If
         
        End If
    Next
   
   
End Sub

You can download demo file.


https://drive.google.com/file/d/1pExHWrGY4cbWid4CSJ956-W5ftTkf7Lm/view?usp=sharing
Click to expand...

Demo file.
MultiTextBox_INTEGER_ONLY.xlsb
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Textbox BackColor Problem
Replies
5
Views
260
rlv01
R
P
  • Question
Exiting a Textbox Problem
2
Replies
10
Views
247
Pacman52
P
P
  • Solved
ComboBoxes - check if a value is selected.
Replies
3
Views
305
dreid1011
dreid1011
P
  • Solved
Checking Textbox For Specific Text Entry
Replies
4
Views
222
Pacman52
P
I
  • Solved
Show or Hide Textbox advice
Replies
8
Views
436
dmt32
D

Forum statistics

Threads
1,215,221
Messages
6,123,701
Members
449,117
Latest member
Aaagu

Share this page

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