Event handler

Control array event handler

The guys at Webucator training services but together a video based on this approach.

Within VBA it is not possible to have an array of controls. Each control must have a unique name and it's own set of events. If you want to handle an event, such as Click, for multiple controls with similar code you have two approaches available. The first is to add code to the event of each control. The other is to use a class taking advantage of the WithEvents and create objects based on the class.

The first approach means that lots of code, often repetitive in nature, is required. Also the controls must be present at design time in order to add the code to the controls event.

The second approach reduces the repetitive code and can be applied to controls created at run time.

In this article I want to address the issue of loose and tight coupling within the class approach. Most explanations of the technique use a tightly coupled approach. This is were the class includes an explicit reference(s) to the userform containing the control. This means the class can not easily be reused in other projects without altering code in either the class or userform or both.

As an example I will create a colour picker userform using each approach. Each user form will appear the same and have the same functionailty, which is to allow the user to select a colour by clicking from a swatch of colours. When a colour is clicked the larger colour tile is updated to reflect the selected colour.

All examples have a routine, m_CreatePalette, to layout the labels used for the colours.
If the AddControls argument is TRUE then the controls will also be added to the userform at run time.

Private Const mCOLORPOT_PREFIX = "ColorPot_"
Private Sub m_CreatePalette(AddControls As Boolean)

    Dim RowIndex As Long
    Dim ColIndex As Long
    Dim TempCtl As MSForms.Label
    Dim Left As Single
    Dim Top As Single
    Dim Name As String
    Dim Palette As Range
    Const COLORPOT_GAP = 2
    Const COLORPOT_SIZE = 24
    
    Set Palette = ThisWorkbook.Names("COLOR_PALETTE").RefersToRange
    
    Top = COLORPOT_GAP
    For RowIndex = 1 To Palette.Rows.Count
        Left = COLORPOT_GAP
        For ColIndex = 1 To Palette.Columns.Count
            Name = mCOLORPOT_PREFIX & Format(RowIndex, "00") & "_" & Format(ColIndex, "00")
            If AddControls Then
                Set TempCtl = Me.Controls.Add("Forms.Label.1", Name, True)
            Else
                Set TempCtl = Me.Controls(Name)
            End If
            With TempCtl
                .Left = Left
                .Top = Top
                .Width = COLORPOT_SIZE
                .Height = COLORPOT_SIZE
                .Caption = ""
                .SpecialEffect = fmSpecialEffectSunken
                .BackColor = Palette.Cells(RowIndex, ColIndex).Interior.Color
            End With
            Left = Left + COLORPOT_SIZE + COLORPOT_GAP
        Next
        Top = Top + COLORPOT_GAP + COLORPOT_SIZE
    Next
            
End Sub

Non class events

Each control was created at design time and has code for the Click event. Below is only the code for 7 of the controls but hopefully you get the idea of how much reptetive code is required.

Private Sub ColorPot_01_01_Click()
    CurrentColor.BackColor = ColorPot_01_01.BackColor
End Sub
Private Sub ColorPot_01_02_Click()
    CurrentColor.BackColor = ColorPot_01_02.BackColor
End Sub
Private Sub ColorPot_01_03_Click()
    CurrentColor.BackColor = ColorPot_01_03.BackColor
End Sub
Private Sub ColorPot_01_04_Click()
    CurrentColor.BackColor = ColorPot_01_04.BackColor
End Sub
Private Sub ColorPot_01_05_Click()
    CurrentColor.BackColor = ColorPot_01_05.BackColor
End Sub
Private Sub ColorPot_01_06_Click()
    CurrentColor.BackColor = ColorPot_01_06.BackColor
End Sub
Private Sub ColorPot_01_07_Click()
    CurrentColor.BackColor = ColorPot_01_07.BackColor
End Sub
'
' ... more Click event code for remaining 53 labels removed for brevity
'

Class events

The class event approach requires code in the userform to store the objects and link them to the controls.

Private m_Pots As Collection
Private Sub m_AssignEvents()

    Dim Palette As Range
    Dim RowIndex As Long
    Dim ColIndex As Long
    Dim Name As String
    Dim ColorPot As CEventTight
    
    Set Palette = ThisWorkbook.Names("COLOR_PALETTE").RefersToRange
    For RowIndex = 1 To Palette.Rows.Count
        For ColIndex = 1 To Palette.Columns.Count
            Name = mCOLORPOT_PREFIX & Format(RowIndex, "00") & "_" & Format(ColIndex, "00")
            Set ColorPot = New CEventTight
            Set ColorPot.Pot = Me.Controls(Name)
            m_Pots.Add ColorPot, CStr(m_Pots.Count + 1)
        Next
    Next

End Sub

The class is named CEventTight

Public WithEvents Pot As MSForms.Label

Private Sub Pot_Click()

    Pot.Parent.CurrentColor.BackColor = Pot.BackColor
    
End Sub

Whilst the quantity of code in the class is small it is tightly coupled as it references the CurrentColor control in the user form. This means that to reuse the class the form must have a control named CurrentColor.

Class event handler

There are actually 2 classes required. One acts as storage of references to indiviual objects. It also raises the event which can be exposed in the userform.

CEventHandler

Public Event Click(Index As Long)
Private m_Pots As Collection
Public Function Add(Ctl As MSForms.Label) As CEventLoose

    Dim TempCtl As CEventLoose
    
    Set TempCtl = New CEventLoose
    TempCtl.Index = m_Pots.Count + 1
    Set TempCtl.Parent = Me
    Set TempCtl.Pot = Ctl
    m_Pots.Add TempCtl, Ctl.Name
    
    Set Add = TempCtl
    
End Function
Public Property Get Count() As Long
    Count = m_Pots.Count
End Property
Public Function Item(Index As Variant) As CEventLoose
    On Error Resume Next
    Set Item = m_Pots(Index)
    Exit Function
End Function
Public Function Items() As Collection
    Set Items = m_Pots
End Function
Public Sub Remove(Index As Variant)
    On Error Resume Next
    m_Pots.Remove Index
    Exit Sub
End Sub
Private Sub Class_Initialize()

    Set m_Pots = New Collection
    
End Sub
Private Sub Class_Terminate()

    Do While m_Pots.Count > 0
        m_Pots.Remove m_Pots.Count
    Loop
    Set m_Pots = Nothing
    
End Sub
Public Sub EventClick(Index As Long)
    RaiseEvent Click(Index)
End Sub

CEventLoose

Public WithEvents Pot As MSForms.Label
Public Parent As CEventHandler
Public Index As Long
Private Sub Pot_Click()
    Me.Parent.EventClick Index
End Sub

Userform code to declare and consume the event handler

Private WithEvents m_Pots As CEventHandler
Private Sub m_Pots_Click(Index As Long)

    CurrentColor.BackColor = m_Pots.Item(Index).Pot.BackColor
    
End Sub
Private Sub m_AssignEventHandler()

    Dim Palette As Range
    Dim RowIndex As Long
    Dim ColIndex As Long
    Dim Name As String
    Dim ColorPot As MSForms.Label
    
    Set Palette = ThisWorkbook.Names("COLOR_PALETTE").RefersToRange
    For RowIndex = 1 To Palette.Rows.Count
        For ColIndex = 1 To Palette.Columns.Count
            Name = mCOLORPOT_PREFIX & Format(RowIndex, "00") & "_" & Format(ColIndex, "00")
            Set ColorPot = Me.Controls(Name)
            m_Pots.Add ColorPot
        Next
    Next

End Sub

The CEventLoose class captures the click event in the same way as the CEventTight does. But rather than changing the property of a control directly it calls a routine in the CEventHandler class, passing information about which object it is, allowing the handler to raise an event. This event is exposed by the object when declared WithEvents in the userform. When the event fires code within the userform can process any actions required. This means the 2 classes can be used in any project without the need for code changes. All project specific code is done within the userform.

In the example I have only used the Click event but the principle can be extended to all events that are exposed when using WithEvents. Unfortunately this is not the complete complement of events as a few, such as Enter and Exit, are only exposed when used in a suitable container object.

The download file also includes another example file where events are reported to a listbox. Along with event code to provide special textboxes for upper case, lower case and numeric entry only.