How to shorten this long code

J

jptaz

New Member
Joined
May 1, 2020
Messages
46
Office Version
  1. 2010
Platform
  1. Windows
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...

VBA Code: 
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
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
Make separate procedures for your repetitive code ...
VBA Code: 
Private Sub Condition_1()
    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 Reg543_Change()
    Call Condition_1
End Sub
Private Sub Reg544_Change()
    Call Condition_1
End Sub
Private Sub Reg545_Change()
    Call Condition_1
End Sub

Private Sub Condition_2()
    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 Reg547_Change()
    Call Condition_2
End Sub
Private Sub Reg548_Change()
    Call Condition_2
End Sub
Private Sub Reg549_Change()
    Call Condition_2
End Sub

Private Sub Condition_3()
    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 Reg576_Change()
    Call Condition_3
End Sub
Private Sub Reg577_Change()
    Call Condition_3
End Sub
Private Sub Reg578_Change()
    Call Condition_3
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
 
Upvote 0
This might give you something to think about. I'm using the "BeforeUpdate" trigger instead of the "Change" trigger. Then I don't get a call after every character change in the textbox


VBA Code: 
Private Sub Reg543_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  Call cBackColor("Reg543")
End Sub

Private Sub Reg544_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  Call cBackColor("Reg544")
End Sub

Private Sub Reg545_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  Call cBackColor("Reg545")
End Sub

Private Sub UserForm_Initialize()
  Reg543.Value = 30
  Reg544.Value = 31
  Reg545.Value = 32
End Sub



Sub cBackColor(cName As String)
  Dim cNum As Long
  Dim Cntrl(1 To 4) As Object
  Dim X As Long
  Dim Y As Long
  Dim V As Long
  Dim BaseV As Long
  Dim cMin As Long
    
  cNum = Val(Mid(cName, 4, 3))
  
  Select Case cNum
    Case 543 To 545
      BaseV = 543
    Case 547 To 549
      BaseV = 547
    Case 576 To 578
      BaseV = 576
    Case 580 To 582
      BaseV = 580
  End Select
  
  Y = BaseV - 1
  cMin = 999
  For X = 1 To 4
    Y = Y + 1
    Set Cntrl(X) = UserForm1.Controls("Reg" & Y)
    If X < 4 Then
      V = Val(Cntrl(X).Value)
      If V < cMin Then cMin = V
    End If
  Next X
  If cMin >= 45 Then
    Cntrl(4).Enabled = True
    Cntrl(4).BackColor = "&H80000005"
  Else
    Cntrl(4).Enabled = False
    Cntrl(4).BackColor = "&H80000004"
  End If
      
End Sub
 
Upvote 0
jptaz said:
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...
Click to expand...

Hi,
with repeating code you can make a common code and pass an argument to process the differences being tested

Following is untested but may do what you want

VBA Code: 
Enum CheckControlValues
    Check543To545 = 543
    Check547To549 = 547
    Check576To578 = 576
End Enum

Private Sub Reg543_Change()
    CheckValue Check543To545
End Sub
Private Sub Reg544_Change()
    CheckValue Check543To545
End Sub
Private Sub Reg545_Change()
    CheckValue Check543To545
End Sub
Private Sub Reg547_Change()
    CheckValue Check547To549
End Sub
Private Sub Reg548_Change()
    CheckValue Check547To549
End Sub
Private Sub Reg549_Change()
    CheckValue Check547To549
End Sub
Private Sub Reg576_Change()
    CheckValue Check576To578
End Sub
Private Sub Reg577_Change()
    CheckValue Check576To578
End Sub
Private Sub Reg578_Change()
    CheckValue Check576To578
End Sub

Sub CheckValue(ByVal CheckControl As CheckControlValues)
    Dim IsEqualOrGreater As Boolean
    Dim i As Integer
    For i = CheckControl To CheckControl + 3
        IsEqualOrGreater = CBool(Val(Me.Controls("Reg" & i).Value) >= 45)
        With Me.Controls("Reg" & CheckName + 4)
            .Enabled = IsEqualOrGreater
            .BackColor = IIf(IsEqualOrGreater, &H80000005, &H80000004)
        End With
       If IsEqualOrGreater Then Exit Sub
    Next i
End Sub

I have used each controls change event which will call the common code each time you make an entry - An alternative event like AfterUpdate be better suited but you would need to determine this.

To repeat, solution untested & may need some adjustment but hopefully, just another idea that may help you

Hope Helpful

Dave
 
Last edited:
Upvote 0
Darn,
spotted typo after posting

this line
VBA Code: 
With Me.Controls("Reg" & CheckName + 4)

should be this

VBA Code: 
With Me.Controls("Reg" & CheckControl + 4)

Dave
 
Upvote 0
Jeffrey Mahoney said:
This might give you something to think about. I'm using the "BeforeUpdate" trigger instead of the "Change" trigger. Then I don't get a call after every character change in the textbox


VBA Code: 
Private Sub Reg543_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  Call cBackColor("Reg543")
End Sub

Private Sub Reg544_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  Call cBackColor("Reg544")
End Sub

Private Sub Reg545_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  Call cBackColor("Reg545")
End Sub

Private Sub UserForm_Initialize()
  Reg543.Value = 30
  Reg544.Value = 31
  Reg545.Value = 32
End Sub



Sub cBackColor(cName As String)
  Dim cNum As Long
  Dim Cntrl(1 To 4) As Object
  Dim X As Long
  Dim Y As Long
  Dim V As Long
  Dim BaseV As Long
  Dim cMin As Long
   
  cNum = Val(Mid(cName, 4, 3))
 
  Select Case cNum
    Case 543 To 545
      BaseV = 543
    Case 547 To 549
      BaseV = 547
    Case 576 To 578
      BaseV = 576
    Case 580 To 582
      BaseV = 580
  End Select
 
  Y = BaseV - 1
  cMin = 999
  For X = 1 To 4
    Y = Y + 1
    Set Cntrl(X) = UserForm1.Controls("Reg" & Y)
    If X < 4 Then
      V = Val(Cntrl(X).Value)
      If V < cMin Then cMin = V
    End If
  Next X
  If cMin >= 45 Then
    Cntrl(4).Enabled = True
    Cntrl(4).BackColor = "&H80000005"
  Else
    Cntrl(4).Enabled = False
    Cntrl(4).BackColor = "&H80000004"
  End If
     
End Sub
Click to expand...
Wow Thanks, this is a great code, can't say I understand it perfectly, but I like it because it forces me to learn and think.
Thanks again

JP
 
Upvote 0
GWteB said:
Make separate procedures for your repetitive code ...
VBA Code: 
Private Sub Condition_1()
    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 Reg543_Change()
    Call Condition_1
End Sub
Private Sub Reg544_Change()
    Call Condition_1
End Sub
Private Sub Reg545_Change()
    Call Condition_1
End Sub

Private Sub Condition_2()
    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 Reg547_Change()
    Call Condition_2
End Sub
Private Sub Reg548_Change()
    Call Condition_2
End Sub
Private Sub Reg549_Change()
    Call Condition_2
End Sub

Private Sub Condition_3()
    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 Reg576_Change()
    Call Condition_3
End Sub
Private Sub Reg577_Change()
    Call Condition_3
End Sub
Private Sub Reg578_Change()
    Call Condition_3
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
Click to expand...
Thank you very much, it works and it's highly applicable to other controls
 
Upvote 0
I added some descriptions


VBA Code: 
'Provide the name of the calling control
Sub cBackColor(cName As String)
  Dim cNum As Long
  Dim Cntrl(1 To 4) As Object
  Dim X As Long
  Dim Y As Long
  Dim V As Long
  Dim BaseV As Long
  Dim cMin As Long
    
  cNum = Val(Mid(cName, 4, 3))  'get the REG #
  
  Select Case cNum              'What set is it in?
    Case 543 To 545
      BaseV = 543
    Case 547 To 549
      BaseV = 547
    Case 576 To 578
      BaseV = 576
    Case 580 To 582
      BaseV = 580
  End Select
  
  Y = BaseV - 1                 'Start one below then increase in the FOR
  cMin = 999                    'Set to high value
  For X = 1 To 4
    Y = Y + 1                                     'increase Y by 1
    Set Cntrl(X) = UserForm1.Controls("Reg" & Y)  'The the name of the control into an object
    If X < 4 Then                                 'Don't evaluate the last control
      V = Val(Cntrl(X).Value)
      If V < cMin Then cMin = V                   'Set cMin to minimum value of all 3 controls
    End If
  Next X
  If cMin >= 45 Then                              'All controls have at least 45
    Cntrl(4).Enabled = True
    Cntrl(4).BackColor = "&H80000005"
  Else                                            'Not all controls have at least 45
    Cntrl(4).Enabled = False
    Cntrl(4).BackColor = "&H80000004"
  End If
      
End Sub
 
Upvote 0
Here another code for you to consider:

In the userform code:
VBA 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":
VBA Code: 
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.
 
Upvote 0
DanteAmor said:
Here another code for you to consider:

In the userform code:
VBA 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":
VBA Code: 
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.
Click to expand...
Thank you very much very appreciated
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Check two different statements on the Exit Routine
Replies
3
Views
225
Micron
M
P
  • Solved
Textbox BackColor Problem
Replies
5
Views
246
rlv01
R
A
  • Solved
Removing code duplication
2
Replies
12
Views
477
AndyEd
A
W
  • Question
Counter in userform, part 2
Replies
0
Views
424
wpryan
W
P
  • Solved
VBYes/No Responses
Replies
5
Views
344
Pacman52
P

Forum statistics

Threads
1,214,952
Messages
6,122,454
Members
449,083
Latest member
Ava19

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