How to shorten this long code

[jptaz]

Hello,

I have this simple code that will set backcolor and enabled of a textbox depending on the value of 3 other textboxes (four times). I'm sure there is a way to shorten this code, but I can't find how...

Private Sub Reg543_Change()
If Reg543.Value >= "45" Or Reg544.Value >= "45" Or Reg545.Value >= "45" Then
Reg546.Enabled = True
Reg546.BackColor = "&H80000005"
Else
Reg546.Enabled = False
Reg546.BackColor = "&H80000004"
End If
End Sub

Private Sub Reg544_Change()
If Reg543.Value >= "45" Or Reg544.Value >= "45" Or Reg545.Value >= "45" Then
Reg546.Enabled = True
Reg546.BackColor = "&H80000005"
Else
Reg546.Enabled = False
Reg546.BackColor = "&H80000004"
End If
End Sub

Private Sub Reg545_Change()
If Reg543.Value >= "45" Or Reg544.Value >= "45" Or Reg545.Value >= "45" Then
Reg546.Enabled = True
Reg546.BackColor = "&H80000005"
Else
Reg546.Enabled = False
Reg546.BackColor = "&H80000004"
End If
End Sub

Private Sub Reg547_Change()
If Reg547.Value >= "45" Or Reg548.Value >= "45" Or Reg549.Value >= "45" Then
Reg550.Enabled = True
Reg550.BackColor = "&H80000005"
Else
Reg550.Enabled = False
Reg550.BackColor = "&H80000004"
End If
End Sub

Private Sub Reg548_Change()
If Reg547.Value >= "45" Or Reg548.Value >= "45" Or Reg549.Value >= "45" Then
Reg550.Enabled = True
Reg550.BackColor = "&H80000005"
Else
Reg550.Enabled = False
Reg550.BackColor = "&H80000004"
End If
End Sub

Private Sub Reg549_Change()
If Reg547.Value >= "45" Or Reg548.Value >= "45" Or Reg549.Value >= "45" Then
Reg550.Enabled = True
Reg550.BackColor = "&H80000005"
Else
Reg550.Enabled = False
Reg550.BackColor = "&H80000004"
End If
End Sub

Private Sub Reg576_Change()
If Reg576.Value >= "45" Or Reg577.Value >= "45" Or Reg578.Value >= "45" Then
Reg579.Enabled = True
Reg579.BackColor = "&H80000005"
Else
Reg579.Enabled = False
Reg579.BackColor = "&H80000004"
End If
End Sub

Private Sub Reg577_Change()
If Reg576.Value >= "45" Or Reg577.Value >= "45" Or Reg578.Value >= "45" Then
Reg579.Enabled = True
Reg579.BackColor = "&H80000005"
Else
Reg579.Enabled = False
Reg579.BackColor = "&H80000004"
End If
End Sub

Private Sub Reg578_Change()
If Reg576.Value >= "45" Or Reg577.Value >= "45" Or Reg578.Value >= "45" Then
Reg579.Enabled = True
Reg579.BackColor = "&H80000005"
Else
Reg579.Enabled = False
Reg579.BackColor = "&H80000004"
End If
End Sub

Private Sub Reg580_Change()
If Reg580.Value >= "45" Or Reg581.Value >= "45" Or Reg582.Value >= "45" Then
Reg583.Enabled = True
Reg583.BackColor = "&H80000005"
Else
Reg583.Enabled = False
Reg583.BackColor = "&H80000004"
End If
End Sub

Thank you in advance for your advices and your time

JP

 

[DanteAmor]

Glad we could help & thanks for the feedback

 

[jptaz]

Here another code for you to consider:

In the userform code:

Dim TxtBx() As New Class1

Private Sub UserForm_Initialize()
  Dim i As Long, ctrl As MSForms.Control
  For Each ctrl In Me.Controls
    If TypeName(ctrl) = "TextBox" Then
      Select Case Right(ctrl.Name, 3)
        Case 543 To 545, 547 To 549, 576 To 578, 580 To 582
          i = i + 1
          ReDim Preserve TxtBx(i)
          Set TxtBx(i).MultTextBox = ctrl
      End Select
    End If
  Next
End Sub

In a class module "Class1":

Public WithEvents MultTextBox As MSForms.TextBox

Private Sub MultTextbox_Change()
  Dim n As Long, m As Boolean
  n = WorksheetFunction.Lookup(Val(Right(MultTextBox.Name, 3)), Array(543, 547, 576, 580), Array(543, 547, 576, 580))
  With UserForm1
    m = WorksheetFunction.Max(Val(.Controls("Reg" & n)), Val(.Controls("Reg" & n + 1)), Val(.Controls("Reg" & n + 2))) >= 45
    .Controls("Reg" & n + 3).Enabled = m
    .Controls("Reg" & n + 3).BackColor = "&H8000000" & 4 + m * -1
  End With
End Sub

Note: Change the name UserForm1 in Class1 by the name of your userform.

If I already have a class, should I create another one. And how do I had it to the existing code in the userform?

If I may ask another question. My userform has an edit button where it refill every textboxes with my database info. However with the above codes (while it works when adding new entries), excel crashes when I try to edit. Could it be possible that it has something to do with the enabled/disabled status of some textboxes when the userform loads? I don't know if I'm clear...

Thanks again

JP

Option Explicit

Private oldLength As Integer
Private FlgExit As Boolean

Public WithEvents TbxDate As MSForms.TextBox
Public WithEvents Tbx7 As MSForms.TextBox

Private Sub TbxDate_Change()
  ' Empêcher la boucle infinie
  If FlgExit Then FlgExit = False: Exit Sub
  '  Tout est ok
  If oldLength > TbxDate.TextLength Then
    oldLength = TbxDate.TextLength
    Exit Sub
  End If
  ' nb caractères maxi autorisé dans le textbox mettre 8 si tu veux l'année à 2 chiffres
  TbxDate.MaxLength = 10
  '
  If TbxDate.TextLength = 4 Or TbxDate.TextLength = 7 Then
    FlgExit = True
    TbxDate.Text = TbxDate.Text & "-"
  End If
  oldLength = TbxDate.TextLength
End Sub

Private Sub Tbx7_Change()
  ' Empêcher la boucle infinie
  If FlgExit Then FlgExit = False: Exit Sub
  '  Tout est ok
  If oldLength > Tbx7.TextLength Then
    oldLength = Tbx7.TextLength
    Exit Sub
  End If
  ' nb caractères maxi autorisé dans le textbox mettre 8 si tu veux l'année à 2 chiffres
  Tbx7.MaxLength = 7
  '
  If Tbx7.TextLength = 3 Then
    FlgExit = True
    Tbx7.Text = Tbx7.Text & "/"
  End If
  oldLength = Tbx7.TextLength
End Sub

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

 

[GWteB]

Imo the cause of the crash of Excel is not the code of @DanteAmor, rather the code as in your post #12. Within each of the event procedures the code assigns a value to the text property of the respective text box. This assignment triggers the relevant event procedure, ie calling itself and so on, with endlessly running code and ultimately a crash as a result. Temporarily disabling the interception of events should solve your issue.

Private Sub TbxDate_Change()
  ' Empêcher la boucle infinie
  If FlgExit Then FlgExit = False: Exit Sub
  '  Tout est ok
  If oldLength > TbxDate.TextLength Then
    oldLength = TbxDate.TextLength
    Exit Sub
  End If
  ' nb caractères maxi autorisé dans le textbox mettre 8 si tu veux l'année à 2 chiffres
  TbxDate.MaxLength = 10
  '
  If TbxDate.TextLength = 4 Or TbxDate.TextLength = 7 Then
    FlgExit = True
    Application.EnableEvents = False    ' <<<< disable event interception
    TbxDate.Text = TbxDate.Text & "-"   ' this assignment triggers the TbxDate_Change event, ie calling itself
    Application.EnableEvents = True     ' <<<< enable again
  End If
  oldLength = TbxDate.TextLength
End Sub

 

[Fluff]

@GWteB
Application.EnableEvents does not affect controls on a userform & so will have no affect. The FlgExit should be preventing a permanent loop.

 

[GWteB]

@GWteB
Application.EnableEvents does not affect controls on a userform & so will have no affect. The FlgExit should be preventing a permanent loop.

Sometimes I mix things up
You're right on both , so the OP's issue is been caused by something else ...