How to force uppercase for first letter of multiple textboxes

[jptaz]

Hello everyone,

I have this code to force the uppercase of the first letter of a textbox (here textbox name "Reg605").

Private Sub Reg605_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Reg605.SelStart = 0 Then KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

However in my userform, I have 600+ textboxes. Is there a way to adapt this code to most textboxes? Also, if possible, I'd like some textboxes to stay in lowercase of free to choose.

For instance, I'd like to capitalize the fist letter from Reg1 to Reg10, then lowercase Reg11 to Reg17 and Uppercase again Reg18 and so on...

Thanks in advance

Jp

 

[Yongle]

I am away from PC today and will update thread tomorrow if I am able to help further

There appear to be 3 types of textboxes on the userform -have I understood correctly?
- first letter UPPER CASE (code required to force character to be upper case)
- first letter LOWER CASE (code required to force character to be lower case)
- first letter EITHER LOWER CASE OR UPPER CASE (as determined by user input) - is code required to ask user to confirm that first character is correct?

Is it necessary for the input to be amended as the user enters data?
(Obviously much simpler to loop all textboxes amending first character as required)

Are there any other constraints on what may be typed in any of the textboxes?
- how are those constraints handled?
(Possible code conflicts)

(Other than using the value in each textbox and clearing it) is there any other VBA which changes the value in any of the affected textboxes in any way?
(Possible code conflicts)

 

[jptaz]

I am away from PC today and will update thread tomorrow if I am able to help further

There appear to be 3 types of textboxes on the userform -have I understood correctly?
- first letter UPPER CASE (code required to force character to be upper case)
- first letter LOWER CASE (code required to force character to be lower case)
- first letter EITHER LOWER CASE OR UPPER CASE (as determined by user input) - is code required to ask user to confirm that first character is correct?

Is it necessary for the input to be amended as the user enters data?
(Obviously much simpler to loop all textboxes amending first character as required)

Are there any other constraints on what may be typed in any of the textboxes?
- how are those constraints handled?
(Possible code conflicts)

(Other than using the value in each textbox and clearing it) is there any other VBA which changes the value in any of the affected textboxes in any way?
(Possible code conflicts)

Thank you Yongle for your reply

To simplify my request I would say that I only need one code to force character to be upper case. For the other textboxes, it will be up to the user to choose and no code is required to ask if character is correct.

Is it necessary for the input to be amended as the user enters data?
(Obviously much simpler to loop all textboxes amending first character as required)

It's not necessary as long as it get uppercase when exported to the database.

Are there any other constraints on what may be typed in any of the textboxes?
- how are those constraints handled?
(Possible code conflicts)

I have few textboxes where only numbers are accepted and a msg box will pop if a letter is inserted (afterupdate). However the would not be included in the uppercase textboxes

(Other than using the value in each textbox and clearing it) is there any other VBA which changes the value in any of the affected textboxes in any way?
(Possible code conflicts)

Don't know if it counts, but I have code to change some textboxes format to date and numerical once they get exported to my database.


More precisely, if this can help, here the textboxes I'd like to be uppercase (all start with reg)

Reg1 to 4, 9, 10, 18, 24 to 84, 96, 99, 102 to 135, 148, 151, 154 to 156, 164, 187, 341 to 347, 486 to 492, 605 to 611.

Here's my full code

Option Explicit

Dim bFlgExit As Boolean
Dim LocOldLength As Integer
Dim TbxDate() As New Classe1
Dim Tbx7() As New Classe1


'Convertir texte en chiffre dans la base de donnée

Function GetDataType(ByVal Text As String) As Variant
    If IsNumeric(Text) Then
            GetDataType = Val(Text)
      Else
            GetDataType = Text
      End If
End Function

Function GetDataTypeDate(ByVal Text As String) As Variant
    If Text Like "####-##-##" And IsDate(Text) Then
            GetDataTypeDate = DateValue(Text)
       Else
            GetDataTypeDate = Text
      End If
End Function



'date de naissance
Private Function DiffDateAMJ(DateDebut As Date, DateFin As Date) As String
  Dim NbAns As Long, NbMois As Long, NbJours As Long
  Dim Tmp As Date, sA As String, sM As String, sJ As String
 
  Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut))
  NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin)
  NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin))
  NbJours = Day(DateFin) - Day(DateDebut) + 1
 
  If NbJours < 0 Then
    NbMois = NbMois - 1
    NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours
  End If
 
  If NbAns = 0 Then sA = "" Else sA = NbAns & " ans "
  If NbMois = 0 Then sM = "" Else sM = NbMois & "mois "
  If NbJours = 0 Then sJ = "" Else sJ = NbJours & "jours"
 
  DiffDateAMJ = Trim$(sA)
  'DiffDateAMJ = Trim$(sA & sM & sJ) pour avoir ans mois jours
End Function




Private Sub Reg605_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Reg605.SelStart = 0 Then KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub



Private Sub Text_date3_AfterUpdate()
  If IsDate(Me.Text_date3) Then
    Controls.Item("Text_age").Text = DiffDateAMJ(Me.Text_date3, Date)
  End If
End Sub

'Autoriser seulement chiffres et virgules

Private Sub OnlyNumbers()
    If TypeName(Me.ActiveControl) = "TextBox" Then
        With Me.ActiveControl
            If Not IsNumeric(.Value) And .Value <> vbNullString Then
                MsgBox "Chiffres et virgule seulement"
                .Value = vbNullString
            End If
        End With
    End If
End Sub

Private Sub OnlyNumbersframe4()
  'Ensures only numbers are entered in the TextBoxes on the UserForm. This does not affect the TextBoxes on the MultiPage control
  If TypeName(Me.Controls.Item("Frame4").ActiveControl) = "TextBox" Then
    With Me.Controls.Item("Frame4").ActiveControl
      If Not IsNumeric(.Value) And .Value <> vbNullString Then
        MsgBox "Chiffres et virgule seulement"
        .Value = vbNullString
      End If
    End With
  End If
End Sub

Private Sub OnlyNumbersframe5()
  'Ensures only numbers are entered in the TextBoxes on the UserForm. This does not affect the TextBoxes on the MultiPage control
  If TypeName(Me.Controls.Item("Frame5").ActiveControl) = "TextBox" Then
    With Me.Controls.Item("Frame5").ActiveControl
      If Not IsNumeric(.Value) And .Value <> vbNullString Then
        MsgBox "Chiffres et virgule seulement"
        .Value = vbNullString
      End If
    End With
  End If
End Sub


'facteur de risque âge
Private Sub Condition_7()
If ((Controls.Item("Reg6").Text = "Femme") And (Controls.Item("Reg7").Text = "Oui")) Or ((Controls.Item("Reg6").Text = "Femme") And (Controls.Item("Text_age").Text >= "55 ans") And ((Controls.Item("Reg7").Text = "Non") Or (Controls.Item("Reg7").Text = ""))) Then
    Controls.Item("Reg169").Text = "Femme de plus de 55 ans ou ménopausée"
    Controls.Item("Reg192").Text = "Femme de plus de 55 ans ou ménopausée"
  Else
    If (Controls.Item("Reg6").Text = "Homme") And (Controls.Item("Text_age").Text >= "45 ans") Then
      Controls.Item("Reg169").Text = "Homme de plus de 45 ans"
     Controls.Item("Reg192").Text = "Homme de plus de 45 ans"
    Else
     Controls.Item("Reg169").Text = ""
     Controls.Item("Reg192").Text = ""
    End If
  End If

End Sub

'Changer couleur de fond et vérouiller choix ménopause
Private Sub Reg6_change()
  If Controls.Item("Reg6").Text = "Homme" Then
    Controls.Item("Reg7").BackColor = "&H8000000F"
    Controls.Item("Reg7").Enabled = False
    Controls.Item("Reg7").Text = ""
  Else: Controls.Item("Reg7").BackColor = "&H80000005"
  Controls.Item("Reg7").Enabled = True
  End If
  Call Condition_7
End Sub
Private Sub Reg7_change()
Call Condition_7
End Sub
Private Sub text_age_change()
Call Condition_7
End Sub




'Calcul IMC
'Taille (Reg157) (Reg180)
'Poids (Reg158)  (Reg181)
'IMC (Text_imc_ini) (Text_imc_fin)
Private Sub Condition_5()
OnlyNumbersframe4
  If (Controls.Item("Reg157").Text) = "" Or (Controls.Item("Reg158").Text) = "" Then
    Controls.Item("Text_imc_ini").Text = ""
  End If
  If Controls.Item("Reg157").Value = 0 Then
    Controls.Item("Reg157").Value = ""
  End If
  If Reg157 = "" Or Reg158 = "" Then Exit Sub
  Controls.Item("Text_imc_ini").Value = ((Reg158) / (((Reg157) / 100) ^ 2))
  Controls.Item("Text_imc_ini").Value = Format(Controls.Item("Text_imc_ini").Value, "##.##")
  If (Controls.Item("Reg157").Text) = "" And (Controls.Item("Reg158").Text) = "" Then
    Controls.Item("Text_imc_ini").Text = ""
  End If
End Sub
Private Sub Reg157_afterupdate()
  Call Condition_5
End Sub
Private Sub Reg158_afterupdate()
  Call Condition_5
End Sub



Private Sub Text_imc_ini_Change()
  If Controls.Item("Text_imc_ini").Value = "" Then
    Controls.Item("Reg170").Text = ""
  End If

  If Len(Controls.Item("Text_imc_ini").Text) >= 2 Then
    On Error Resume Next
    Reg170 = Application.WorksheetFunction. _
      VLookup(CLng(Controls.Item("Text_imc_ini").Text), Worksheets("lists.vba").Range("F2:g61"), 2, True)
  End If

  If Controls.Item("Text_imc_ini").Value <= "30" Then
   Controls.Item("Reg170").Text = ""
  End If

End Sub

Private Sub Condition_6()
OnlyNumbersframe5
  If (Controls.Item("Reg180").Text) = "" Or (Controls.Item("Reg181").Text) = "" Then
    Controls.Item("Text_imc_fin").Text = ""
  End If
  If Controls.Item("Reg180").Value = 0 Then
    Controls.Item("Reg180").Value = ""
  End If
  If Reg180 = "" Or Reg181 = "" Then Exit Sub
  Controls.Item("Text_imc_fin").Value = ((Reg181) / (((Reg180) / 100) ^ 2))
  Controls.Item("Text_imc_fin").Value = Format(Controls.Item("Text_imc_fin").Value, "##.##")
  If (Controls.Item("Reg180").Text) = "" And (Controls.Item("Reg181").Text) = "" Then
    Controls.Item("Text_imc_fin").Text = ""
  End If
End Sub

Private Sub Reg180_afterupdate()
  Call Condition_6
End Sub
Private Sub Reg181_afterupdate()
  Call Condition_6
End Sub

Private Sub Text_imc_fin_Change()
  If Controls.Item("Text_imc_fin").Value = "" Then
    Controls.Item("Reg193").Text = ""
  End If

  If Len(Controls.Item("Text_imc_fin").Text) >= 2 Then
    On Error Resume Next
    Controls.Item("Reg193").Text = Application.WorksheetFunction. _
      VLookup(CLng(Controls.Item("Text_imc_fin").Text), Worksheets("lists.vba").Range("F2:g61"), 2, True)
  End If
  If Controls.Item("Text_imc_fin").Value <= "30" Then
    Controls.Item("Reg193").Text = ""
  End If
End Sub

'fin calcul IMC



'Tapis roulant vs ergomètre pré

Private Sub Reg205_Change()
Dim ind As Long
For ind = 212 To 213
Controls("Reg" & ind).Enabled = IIf(Controls.Item("Reg205").Text = "Tapis roulant", "true", "false")
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg205").Text = "Tapis roulant", "&H80000005", "&H80000004")
Next ind
For ind = 214 To 215
Controls("Reg" & ind).Enabled = IIf(Controls.Item("Reg205").Text = "Tapis roulant", "false", "true")
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg205").Text = "Tapis roulant", "&H80000004", "&H80000005")
Next ind
If Controls.Item("Reg205").Text = "Tapis roulant" Then
Controls.Item("Label114").Caption = "Pente"
Else
Controls.Item("Label114").Caption = "Watt"
End If

If Controls.Item("Reg205").Text = "" Then
Controls.Item("Label114").Caption = "Pente / Watt"
End If


End Sub

'Tapis roulant vs ergomètre post

Private Sub Reg350_Change()
Dim ind As Long
For ind = 357 To 358
Controls("Reg" & ind).Enabled = IIf(Controls.Item("Reg350").Text = "Tapis roulant", "false", "true")
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg350").Text = "Tapis roulant", "&H80000004", "&H80000005")
Next ind
For ind = 359 To 360
Controls("Reg" & ind).Enabled = IIf(Controls.Item("Reg350").Text = "Tapis roulant", "true", "false")
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg350").Text = "Tapis roulant", "&H80000005", "&H80000004")
Next ind
If Controls.Item("Reg350").Text = "Tapis roulant" Then
Controls.Item("Label323").Caption = "Pente"
Else
Controls.Item("Label323").Caption = "Watt"
End If
If Controls.Item("Reg350").Text = "" Then
Controls.Item("Label323").Caption = "Pente / Watt"
End If
End Sub




' Protocole adapté (vitesse et pente) ini

Private Sub Reg206_Change()
Dim ind As Long
For ind = 301 To 340
Controls("Reg" & ind).Enabled = Controls.Item("Reg206").Text = "Protocole adapté"
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg206").Text = "Protocole adapté", "&H80000005", "&H80000004")
Next ind

End Sub

' Protocole adapté (vitesse et pente) fin

Private Sub Reg351_Change()

Dim ind As Long
For ind = 446 To 485
Controls("Reg" & ind).Enabled = Controls.Item("Reg351").Text = "Protocole adapté"
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg351").Text = "Protocole adapté", "&H80000005", "&H80000004")
Next ind

End Sub




'Circuit d'activités physiques
Private Sub Reg493_Change()
Dim ind As Long
For ind = 494 To 495
Controls("Reg" & ind).Enabled = IIf(Controls.Item("Reg493").Text = "Oui", "True", "False")
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg493").Text = "Oui", "&H80000005", "&H80000004")
Next ind
For ind = 498 To 502
Controls("Reg" & ind).Enabled = IIf(Controls.Item("Reg493").Text = "Oui", "True", "False")
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg493").Text = "Oui", "&H80000005", "&H80000004")
Next ind

End Sub

Private Sub Reg512_Change()
Dim ind As Long
For ind = 513 To 514
Controls("Reg" & ind).Enabled = IIf(Controls.Item("Reg512").Text = "Oui", "True", "False")
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg512").Text = "Oui", "&H80000005", "&H80000004")
Next ind
For ind = 517 To 521
Controls("Reg" & ind).Enabled = IIf(Controls.Item("Reg512").Text = "Oui", "True", "False")
Controls("Reg" & ind).BackColor = IIf(Controls.Item("Reg512").Text = "Oui", "&H80000005", "&H80000004")
Next ind

End Sub





'Équilibre unipodal > 45 sec

Private Sub Condition_1()
    If Controls.Item("Reg549").Value >= "45" Or Controls.Item("Reg550").Value >= "45" Or Controls.Item("Reg551").Value >= "45" Then
        Controls.Item("Reg552").Enabled = True
        Controls.Item("Reg552").BackColor = "&H80000005"
    Else
        Controls.Item("Reg552").Enabled = False
        Controls.Item("Reg552").BackColor = "&H80000004"
    End If
End Sub

Private Sub Reg549_AfterUpdate()
    Call Condition_1
End Sub
Private Sub Reg550_AfterUpdate()
    Call Condition_1
End Sub
Private Sub Reg551_AfterUpdate()
    Call Condition_1
End Sub

Private Sub Condition_2()
    If Controls.Item("Reg553").Value >= "45" Or Controls.Item("Reg554").Value >= "45" Or Controls.Item("Reg555").Value >= "45" Then
        Controls.Item("Reg556").Enabled = True
        Controls.Item("Reg556").BackColor = "&H80000005"
    Else
        Controls.Item("Reg556").Enabled = False
        Controls.Item("Reg556").BackColor = "&H80000004"
    End If
End Sub

Private Sub Reg553_AfterUpdate()
    Call Condition_2
End Sub
Private Sub Reg554_AfterUpdate()
    Call Condition_2
End Sub
Private Sub Reg555_AfterUpdate()
    Call Condition_2
End Sub

Private Sub Condition_3()
    If Controls.Item("Reg586").Value >= "45" Or Controls.Item("Reg587").Value >= "45" Or Controls.Item("Reg588").Value >= "45" Then
        Controls.Item("Reg589").Enabled = True
        Controls.Item("Reg589").BackColor = "&H80000005"
    Else
        Controls.Item("Reg589").Enabled = False
        Controls.Item("Reg589").BackColor = "&H80000004"
    End If
End Sub

Private Sub Reg586_AfterUpdate()
    Call Condition_3
End Sub
Private Sub Reg587_AfterUpdate()
    Call Condition_3
End Sub
Private Sub Reg588_AfterUpdate()
    Call Condition_3
End Sub

Private Sub Condition_4()
If Controls.Item("Reg590").Value >= "45" Or Controls.Item("Reg591").Value >= "45" Or Controls.Item("Reg592").Value >= "45" Then
    Controls.Item("Reg593").Enabled = True
    Controls.Item("Reg593").BackColor = "&H80000005"
Else
    Controls.Item("Reg593").Enabled = False
    Controls.Item("Reg593").BackColor = "&H80000004"
End If
End Sub

Private Sub Reg590_AfterUpdate()
    Call Condition_4
End Sub

Private Sub Reg591_AfterUpdate()
    Call Condition_4
End Sub

Private Sub Reg592_AfterUpdate()
    Call Condition_4
End Sub
'fin Équilibre unipodal >45


'Dominance préhension

Private Sub Reg8_AfterUpdate()
Controls.Item("Reg541").Text = Controls.Item("Reg8").Text
Controls.Item("Reg578").Text = Controls.Item("Reg8").Text
End Sub





'convertir kg en livres

Private Sub Text_kg2_Change()
  On Error Resume Next
  OnlyNumbers
  If Controls.Item("Text_kg2").Text = "" Then
    Controls.Item("Text_livres2").Text = ""
  Else
    Controls.Item("Text_livres2").Text = (Text_kg2 * 2.2)
    Controls.Item("Text_livres2").Value = Format(Controls.Item("Text_livres2").Value, "###.##")
  End If
End Sub


'convertir livres en kg

Private Sub Text_livres1_Change()
  On Error Resume Next
  OnlyNumbers
  If Controls.Item("Text_livres1").Value = "" Then
    Controls.Item("Text_kg1").Text = ""
  Else
    Controls.Item("Text_kg1").Text = (Text_livres1 / 2.2)
    Controls.Item("Text_kg1").Value = Format(Controls.Item("Text_kg1").Value, "###.##")
  End If
End Sub


'convertir cm en pouces

Private Sub Text_cm_Change()
  OnlyNumbers
  If Controls.Item("Text_cm").Text = "" Then
    Controls.Item("Text_pouces").Text = ""
  Else
    Controls.Item("Text_pouces").Text = (Text_cm / 2.54)
    Controls.Item("Text_pouces").Value = Format(Controls.Item("Text_pouces").Value, "##.#")
  End If
End Sub





[B]' When we click the 'continue' button
Private Sub CommandButton1_Click()
  Dim Sht As Worksheet, cStart As Range
  Dim LasteRow As Long
  Dim TargetRow As Long 'variable for position control
  Dim FullName As String 'full name
  Dim UserMessage As String 'variable to configure user message at the end
  Dim ind As Long
  Dim Dossier As String
  
  
  ' Désactiver les évènements et le calcul auto
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  '
  Dossier = Reg5
  FullName = Reg4 & " " & Reg3 'concatenate first and surname for use in code below
  ' Define the work sheet
  Set Sht = ThisWorkbook.Sheets("Data")
  Set cStart = Sht.Range("Data_Start")
  ' The last row
  LasteRow = Sht.ListObjects("Tableau1").ListRows.Count
  'begin check if in 'edit' or 'add new' mode
  If Sheets("Engine").Range("B4").Value = "NEW" Then 'in 'new' mode
    'begin validation check 'check if name already exists
    If Application.WorksheetFunction.CountIf(Sht.Range("H8:d" & LasteRow), Dossier) > 0 Then
      MsgBox "Le numéro de dossier existe déjà", 0, "Check"
      Exit Sub 'notify user and exit the routine
    End If
    'end validation check
    TargetRow = Sht.ListObjects("Tableau1").Range(LasteRow, 1).End(xlUp).Row - 7 + 1
    UserMessage = " a été ajouté à la base de données" 'configure user message for add new entry
  Else 'in 'edit' mode
    TargetRow = Sheets("Engine").Range("B5").Value 'make variable equal to the value saved in the engine
    UserMessage = " a été modifié" 'configure user message for edit entry
  End If
  '''BEGIN INPUT DATA INTO DATABASE'''
  cStart.Offset(TargetRow, 0).Value = TargetRow 'ref
  cStart.Offset(TargetRow, 1).Value = UCase(Reg4) & " " & Reg3 'Txt_First 'full name 'concatenate
  
    For ind = 1 To 611
  cStart.Offset(TargetRow, 2 + ind - 1).Value = GetDataType(Controls("Reg" & ind).Value)
  Next ind
  
   
    For ind = 1 To 23
  cStart.Offset(TargetRow, 613 + ind - 1).Value = GetDataTypeDate(Controls("Text_date" & ind).Value)
  Next ind
  
  
  
  ' Réactiver les évènements et le calcul auto
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  '''END INPUT DATA INTO DATABASE'''
  Unload Data_UF 'close the userform
  MsgBox FullName & UserMessage, 0, "Complété" 'display message box (configured according to mode)






End Sub

Private Sub CommandButton2_Click()
  Unload Data_UF
End Sub
[/B]


' Utilisation d'un module de classe pour tous les controls contenant le terme "date"
Private Sub UserForm_Initialize()
  Dim ctl As Control, ind As Long, Ind7 As Integer
  
  ind = 0: Ind7 = 0
  ' Pour chaque control de l'UserForm
  For Each ctl In Me.Controls
    ' Si son nom contient "date"
    If InStr(1, ctl.name, "date", vbTextCompare) > 0 Or _
      InStr(1, "Text_sign_ini,Text_sign_fin", ctl.name) > 0 Then
      ' Définir une classe pour ce control
      ' Saisie d'une date de 10 caractères
      ind = ind + 1
      ReDim Preserve TbxDate(1 To ind)
      Set TbxDate(ind).TbxDate = ctl
    End If
    ' 2 control avec saisi d'une date de 7 caractères
      If InStr(1, "Reg210,Reg356,", ctl.name & ",") > 0 Then    'possible d'ajouter vbTextCompare
 
      Ind7 = Ind7 + 1
      ReDim Preserve Tbx7(1 To Ind7)
      Set Tbx7(Ind7).Tbx7 = ctl
    End If
  Next ctl
End Sub

Thanks again for your time

JP

 

[Yongle]

Test on a copy of your data!

Place this code in sub used to do the tidying up before updating the values in database
(must be in userform code window)

    Dim c As Control
    For Each c In UserForm1.Controls
        If TypeName(c) = "TextBox" Then
            If TestName(c.Name) = True Then c.Value = UpperCaseFirst(c.Value)
        End If
    Next

It calls these 2 functions
(place in userform code window)

Private Function TestName(nm As String) As Boolean
    On Error GoTo Handling
    Select Case CInt(Replace(nm, "Reg", ""))
        Case 1 To 4, 9, 10, 18, 24 To 84, 96, 99, 102 To 135, 148, 151, 154 To 156, 164, 187, 341 To 347, 486 To 492, 605 To 611
            TestName = True
    End Select
Handling:
    On Error GoTo 0
End Function
Private Function UpperCaseFirst(txt As String) As String
    txt = txt & "  "
    Mid$(txt, 1, 1) = UCase(Mid$(txt, 1, 1))
    UpperCaseFirst = Trim(txt)
End Function

 

[mikerickson]

A userform's module can act like a Class Module.
In the Activate event, one loops through the textboxes and instansizes a class that handles the capitalization.

' in userform1 code module

Public CommonTextBoxes As Collection
Public WithEvents CommonTextBox As MSForms.TextBox

Private Sub CommonTextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Me.CommonTextBox.SelStart = 0 Then KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub UserForm_Activate()
    Dim i As Long
    Dim NewCommonBox As UserForm1
    Set CommonTextBoxes = New Collection
    For i = 1 To 4
        Set NewCommonBox = New UserForm1
        Set NewCommonBox.CommonTextBox = Me.Controls("TextBox" & i)
        CommonTextBoxes.Add Item:=NewCommonBox
    Next i
    Set NewCommonBox = Nothing
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Dim oneBox As UserForm1
    Dim i As Long, j As Long
    Do Until CommonTextBoxes.Count <= 0
        Set oneBox = CommonTextBoxes(1)
        CommonTextBoxes.Remove 1
    Loop
End Sub


' your userform code goes here

One way to designate which boxes are to be UpperCased and which aren't. you could make the default .Tag property be "uc" to mark which textboxes are to have the Upper case coding. in that case the loop would look like

Private Sub UserForm_Activate()
    Dim oneControl as MSForms.Control
    Dim NewCommonBox As UserForm1
    Set CommonTextBoxes = New Collection

    For Each oneControl in Me.Controls
        If TypeName(oneControl) = "TextBox" And OneControl.Tag = "uc" Then
            Set NewCommonBox = New UserForm1
            Set NewCommonBox.CommonTextBox = oneControl
            CommonTextBoxes.Add Item:=NewCommonBox
        End If
    Next i

    Set NewCommonBox = Nothing
End Sub

 

[Yongle]

@mikerickson
My solution on thread link below was via class module for command button click events
- could your method (making UserForm module act as a class module) be a simpler viable alternative?
- if so, could you post an alternative solution on that thread
thanks

Code to change with each button - 690 buttons

Hello I thank you in advance for your attention and time dedicated to my question. I am trying to program some buttons and found the following solution. Private Sub bt_1_1_Click() txt_1.Value = 1 txt_2.Value = 1 bt_1_1.BackStyle = fmBackStyleOpaque bt_1_1.BackColor = RGB(255...

www.mrexcel.com

 

[mikerickson]

@Yongle
The class module code could be put in the code for the userform, I wouldn't call it simpler.
In the linked thread the question was asked about two different userforms using the same Class, which make more sense if it were a class module rather than a UF. My approach works best when the common control and the userform are the same.

 

[Yongle]

@mikerickson - thanks - I have messaged one follow up question to avoid cluttering this thread

 

[jptaz]

A userform's module can act like a Class Module.
In the Activate event, one loops through the textboxes and instansizes a class that handles the capitalization.

' in userform1 code module

Public CommonTextBoxes As Collection
Public WithEvents CommonTextBox As MSForms.TextBox

Private Sub CommonTextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Me.CommonTextBox.SelStart = 0 Then KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub

Private Sub UserForm_Activate()
    Dim i As Long
    Dim NewCommonBox As UserForm1
    Set CommonTextBoxes = New Collection
    For i = 1 To 4
        Set NewCommonBox = New UserForm1
        Set NewCommonBox.CommonTextBox = Me.Controls("TextBox" & i)
        CommonTextBoxes.Add Item:=NewCommonBox
    Next i
    Set NewCommonBox = Nothing
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Dim oneBox As UserForm1
    Dim i As Long, j As Long
    Do Until CommonTextBoxes.Count <= 0
        Set oneBox = CommonTextBoxes(1)
        CommonTextBoxes.Remove 1
    Loop
End Sub


' your userform code goes here

One way to designate which boxes are to be UpperCased and which aren't. you could make the default .Tag property be "uc" to mark which textboxes are to have the Upper case coding. in that case the loop would look like

Private Sub UserForm_Activate()
    Dim oneControl as MSForms.Control
    Dim NewCommonBox As UserForm1
    Set CommonTextBoxes = New Collection

    For Each oneControl in Me.Controls
        If TypeName(oneControl) = "TextBox" And OneControl.Tag = "uc" Then
            Set NewCommonBox = New UserForm1
            Set NewCommonBox.CommonTextBox = oneControl
            CommonTextBoxes.Add Item:=NewCommonBox
        End If
    Next oneControl

    Set NewCommonBox = Nothing
End Sub

Thank you both for your help, everything works flawlessly. Mikerickson's code is a little easier for my needs. (Changed the Next i for Next oneControl)

Have a nice day : )