One code for multiple Userform Control changes

[danhbanh]

Hi all, I'm having some issues trying to understand and implement some code to achieve what i'm trying to do:

At the moment, I have a Userform with a bunch of TextBoxes and OptionButtons.

I have initially created some code for an Change event for one text box (lets say TextBox1).

I now want TextBox3, Textbox9 and OptionButton2 to trigger the same code as TextBox1. Is there a way to group a selection of Controls to trigger one piece of code instead of adding a Change Event for each control?

I have done some reading and found code which achieves the same using a class module, but this is for all Controls of one type on the form, but I'm not sure how to adapt this to my situation
Excel VBA Userform - Execute Sub when something changes - Stack Overflow

I have the code I want executed in a module of their own so far instead of a sub if that makes any difference?

Thanks in advance

 

[Norie]

Can't you just call the code from the Change event of each of the 4 controls?

 

[danhbanh]

Hi Norie, thank's for your reply.
That is one option that I have thought about yes, but I've inherited this wb from a previous colleague and there are over 100 textboxes, around 60 checkboxes and 20 optionbuttons. I was enquiring to see if there was a more efficient or neater way to do it than adding a change event for each and every single control.

 

[Norie]

If you wanted the same thing to happen in the Change event of controls of the same type, eg textboxes, you could use a class.

However you can't use the same class for the Change event of controls of different types.

You could always set up 3 separate classes, one each for textboxes, checkboxes and option buttons.

Oh, and you don't need to add all the controls to a class, you can easily set something up that only adds the controls you want to a class.

 

[Kyle123]

Or one class with three withevents

 

[AddinBox_Tsunoda]

Hi all.


I have the general-purpose class module (clsBpca) which I designed to be able to settle
an event handling of plural control as Control-Array.


Please look at the following figure and the site about the structure.
(Because I do not protect the macro, you can watch the macro of the class modules.)


[ Illustration of clsBpca Concept ]
http://www.h3.dion.ne.jp/~sakatsu/GifImg/GifDoc/Bpca_Concept.gif
[ clsBpca document ]
AddinBox( Breakthrough in the Pseudo Control Array )
[ Usage example ]
AddinBox( Breakthrough in the Pseudo Control Array )
[ Download & Reference guide ]
AddinBox( Breakthrough in the Pseudo Control Array : clsBpca Reference )


The preparations are completed just to import the class module mentioned above in your workbook.
It is not necessary for you to modify the code of the class module.






a) You can program it as follows when you use clsBpca.
b) The grouping of TextBox/CheckBox/OptionButton in the following example is suitable.
You may summarize it in one or may divide it into some more.
You should only do similar coding.
c) In the following example, I validate Change/Exit event.
Other events are available if you appoint the necessary events in the argument of the Rgst method.
d) In clsBpca, the spelling of the Exit event procedure becomes "OnExit".

-- UserForm module --
Private WithEvents TextGrp1 As clsBpca  '1-50
Private WithEvents TextGrp2 As clsBpca  '51-100
Private WithEvents ChkGrp1 As clsBpca   '1-30
Private WithEvents ChkGrp2 As clsBpca   '31-60
Private WithEvents OptGrp1 As clsBpca   '1-20


Private Sub UserForm_Initialize()
Dim j As Integer
  Set TextGrp1 = New clsBpca
  With TextGrp1
    For j = 1 To 50
      .Add Me.Controls("TextBox" & j)
    Next j
    .Rgst  BPCA_Change + BPCA_Exit
  End With


  Set TextGrp2 = New clsBpca
  With TextGrp2
    For j = 51 To 100
      .Add Me.Controls("TextBox" & j)
    Next j
    .Rgst  BPCA_Change + BPCA_Exit
  End With


  Set ChkGrp1 = New clsBpca
  With ChkGrp1
    For j = 1 To 30
      .Add Me.Controls("CheckBox" & j)
    Next j
    .Rgst  BPCA_Change
  End With


  Set ChkGrp2 = New clsBpca
  With ChkGrp2
    For j = 31 To 60
      .Add Me.Controls("CheckBox" & j)
    Next j
    .Rgst  BPCA_Change
  End With


  Set OptGrp1 = New clsBpca
  With OptGrp1
    For j = 1 To 20
      .Add Me.Controls("OptionButton" & j)
    Next j
    .Rgst  BPCA_Change
  End With
End Sub


Private Sub UserForm_Terminate()
  TextGrp1.Clear
  TextGrp2.Clear
  ChkGrp1.Clear
  ChkGrp2.Clear
  OptGrp1.Clear
  Set TextGrp1 = Nothing
  Set TextGrp2 = Nothing
  Set ChkGrp1 = Nothing
  Set ChkGrp2 = Nothing
  Set OptGrp1 = Nothing
End Sub




' All events of controls are handled by these one procedure in UserForm module.
'-----------------------------------------------------
Private Sub ChkGrp1_Change(ByVal Index As Integer)  'CheckBox1-30
  If (ChkGrp1.Item(Index).Value = True) Then
     'ON processing
     MsgBox ChkGrp1.Item(Index).Name & " [ON]"
  Else
     'OFF processing
     MsgBox ChkGrp1.Item(Index).Name & " [OFF]"
  End If
End Sub
'-----------------------------------------------------
Private Sub ChkGrp2_Change(ByVal Index As Integer)  'CheckBox31-60
  If (ChkGrp2.Item(Index).Value = True) Then
     'ON processing
     MsgBox ChkGrp2.Item(Index).Name & " [ON]"
  Else
     'OFF processing
     MsgBox ChkGrp2.Item(Index).Name & " [OFF]"
  End If
End Sub
'-----------------------------------------------------
Private Sub OptGrp1_Change(ByVal Index As Integer)  'OptionButton1-20
  If (OptGrp1.Item(Index).Value = True) Then
     'ON processing
     MsgBox OptGrp1.Item(Index).Name & " [ON]"
  Else
     'OFF processing
     MsgBox OptGrp1.Item(Index).Name & " [OFF]"
  End If
End Sub
'-----------------------------------------------------
Private Sub TextGrp1_Change(ByVal Index As Integer)  'TextBox1-50
  'Any processing for TextGrp1.Item(Index)
End Sub


Private Sub TextGrp1_OnExit(ByVal Index As Integer, _
                        ByVal Cancel As MSForms.ReturnBoolean)  'TextBox1-50
  If ( Any invalid condition ) Then
    Beep
    Cancel = True
    Exit Sub
  End If
Exit Sub
'-----------------------------------------------------
Private Sub TextGrp2_Change(ByVal Index As Integer)  'TextBox51-100
  'Any processing for TextGrp2.Item(Index)
End Sub


Private Sub TextGrp2_OnExit(ByVal Index As Integer, _
                        ByVal Cancel As MSForms.ReturnBoolean)  'TextBox51-100
  If ( Any invalid condition ) Then
    Beep
    Cancel = True
    Exit Sub
  End IF
Exit Sub

 

[mikerickson]

You could put this code in a Class module named clsCommonControl

' in clsCommonControl class module

Public WithEvents pTextBox As MSForms.TextBox
Public WithEvents pOptionButton As MSForms.OptionButton
Dim pControl As MSForms.Control

Event Change()
Event DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Property Get CommonControl() As MSForms.Control
    Set CommonControl = pControl
End Property

Property Set CommonControl(ctrl As MSForms.Control)
    Set pControl = ctrl
    If TypeName(pControl) = "TextBox" Then
        Set Me.pTextBox = pControl
    ElseIf TypeName(pControl) = "OptionButton" Then
        Set Me.pOptionButton = pControl
    End If
End Property

Private Sub pOptionButton_Change()
    Set ParentUF.CommonControl = Me
    RaiseEvent Change
End Sub

Private Sub pOptionButton_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Set ParentUF.CommonControl = Me
    RaiseEvent DblClick(Cancel)
End Sub

Private Sub pTextBox_Change()
    Set ParentUF.CommonControl = Me
    RaiseEvent Change
End Sub

Private Sub pTextBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Set ParentUF.CommonControl = Me
    RaiseEvent DblClick(Cancel)
    MsgBox Cancel
End Sub

Private Function ParentUF() As Object
    Dim Parent As Object
    Set Parent = pControl
    On Error Resume Next
        Do
            Set Parent = Parent.Parent
        Loop Until Err
    On Error GoTo 0
    Set ParentUF = Parent
End Function

and this code in the user form.
Note that the code for the common event is in the user form not in the custom class.
This class passes the Change and DblClick events of any of the indicated controls to the userform's module scoped object CommonControl.

Sub CommonControl_Click in the user form's code module. As is, Sub CommonControl_DblClick(ByVal Cancel As MSForms.ReturnBoolean).

(Other events can be added to clsCommonControl)

' in userform's code module

Dim CommonControls As Collection
Public WithEvents CommonControl As clsCommonControl


Private Sub UserForm_Initialize()
    Dim newControl As clsCommonControl
    Dim oneControl As Variant
    
    Set CommonControls = New Collection
    
    Rem make selected controls part of CommonControls
    For Each oneControl In Array(OptionButton1, TextBox1, OptionButton3)
        Set newControl = New clsCommonControl
        Set newControl.CommonControl = oneControl
        CommonControls.Add Item:=newControl, Key:=oneControl.Name
    Next oneControl
    
    Set newControl = Nothing
End Sub

Private Sub CommonControl_Change()
    With CommonControl.CommonControl
        MsgBox .Name & " has changed"
    End With
End Sub

Private Sub CommonControl_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With CommonControl.CommonControl
        MsgBox .Name & " has been double clicked."
    End With
    Cancel = True
End Sub