VBA Raising event on another class

Question

I am trying to implement the suggestions from this post in codereview

Objective:

Manage what happens when users interact with Excel Tables (ListObjects)

The idea at the end is to have custom events for different tables. e.g. When you add a row to table1 the custom AddEvent1 is raised, and when you do the same to table2, AddEvent2 is raised.

There would be only one class to manage the events and one to hold the tables and their information.

---

So the process suggested is to:

1. Add the listobject to a class called Table
2. That class would listen to the events on the parent sheet (Change and SelectionChange)
3. When a change event is fired, trigger a custom event from a class TableManager that handles those events (events like adding, updating or deleting rows)

---

EDIT #1:

Adjusted the code:

• The Create function now returns an instance of a Table
• And the property Set SourceTable now sets the listObjectParentSheet field to the corresponding value

But still the Table Manager doesn't listen to the event raised in listObjectParentSheet_Change

---

Components:

1) A Sheet with an Excel Table (ListObject) and the following code behind:

Private Sub Worksheet_Activate()

    Dim myTable As Table
    Dim myTableManager As TableManager

    Set myTable = Table.Create(Me.ListObjects(1))

    Set myTableManager = New TableManager

    Set myTableManager.TableInstance = myTable

End Sub

2) Class Table (with a predeclared id set to true using rubberduck)

'@Folder("VBAProject")

Option Explicit
'@PredeclaredId

Private Type TTable
    SourceTable As ListObject
End Type

Private this As TTable

Private WithEvents listObjectParentSheet As Excel.Worksheet

Public Event AddEvent()

Public Property Get SourceTable() As ListObject
    Set SourceTable = this.SourceTable
End Property

Public Property Set SourceTable(ByVal value As ListObject)
    Set this.SourceTable = value
    Set listObjectParentSheet = value.Parent
End Property

Public Property Get Self() As Table
    Set Self = Me
End Property

Public Function Create(ByVal EvalSourceTable As ListObject) As Table
    With New Table
        Set .SourceTable = EvalSourceTable
        Set Create = .Self
    End With
End Function

Private Sub listObjectParentSheet_Change(ByVal Target As Range)
    If Not Intersect(Target, SourceTable.DataBodyRange) Is Nothing Then
        MsgBox listObjectParentSheet.Name & " " & Target.Address
        RaiseEvent AddEvent
    End If
End Sub

3) Class TableManager

Option Explicit

Private WithEvents m_table As Table

Public Property Get TableInstance() As Table
    Set TableInstance = m_table
End Property

Public Property Set TableInstance(ByRef tableObject As Table)
    Set m_table = tableObject
End Property

Private Sub m_table_AddEvent()
    MsgBox "Adding something"
End Sub

---

Question/issue:

I haven't figure out how to fire the "AddEvent" in the TableManager class. I know I have messed up some concepts of instantiating the classes, but I don't know what I am doing wrong.

---

Expected result:

When user changes any cell of the listobject, show the message box "Adding something" when the AddEvent is raised

---

Any help would be really appreciated.

EDIT #2

Final code thanks to Mat's answer:

Sheet: Sheet1:

Private Sub Worksheet_Activate()
    With TableManager
        Set .TableEvents = Table.Create(Sheet1.ListObjects(1))
    End With
End Sub

Module: ListObjectUtilities

Option Explicit

Public Function GetCellRow(ByVal EvalTable As ListObject, ByVal EvalCell As Range) As Long

    If Intersect(EvalCell, EvalTable.DataBodyRange) Is Nothing Then Exit Function

    GetCellRow = EvalCell.Row - EvalTable.HeaderRowRange.Row

End Function

Public Function GetCellColumn(ByVal EvalTable As ListObject, ByVal EvalCell As Range) As Long

    If Intersect(EvalCell, EvalTable.DataBodyRange) Is Nothing Then Exit Function

    GetCellColumn = EvalCell.Column - EvalTable.HeaderRowRange.Column + 1

End Function

Class: ITable

Option Explicit

Public Property Get SourceTable() As ListObject
End Property

Class: Table

'@Folder("VBAProject")
'@PredeclaredId
Option Explicit

Private WithEvents TableSheet As Excel.Worksheet

Private Type TTable
    SourceTable As ListObject
    LastRowCount As Long
    LastColumnCount As Long
End Type

Private this As TTable

Public Event Changed(ByVal cell As Range)
Public Event AddedNewRow(ByVal newRow As ListRow)
Public Event AddedNewColumn(ByVal newColumn As ListColumn)

Implements ITable

Public Function Create(ByVal Source As ListObject) As ITable
    With New Table
        Set .SourceTable = Source
        Set Create = .Self
    End With
End Function

Public Property Get Self() As Table
    Set Self = Me
End Property

Public Property Get SourceTable() As ListObject
    Set SourceTable = this.SourceTable
End Property

Public Property Set SourceTable(ByVal value As ListObject)
    ThrowIfSet this.SourceTable
    ThrowIfNothing value
    Set TableSheet = value.Parent
    Set this.SourceTable = value
    Resize
End Property

Friend Sub OnChanged(ByVal Target As Range)
    RaiseEvent Changed(Target)
End Sub

Friend Sub OnAddedNewRow(ByVal newRow As ListRow)
    RaiseEvent AddedNewRow(newRow)
End Sub

Friend Sub OnAddedNewColumn(ByVal newColumn As ListColumn)
    RaiseEvent AddedNewColumn(newColumn)
End Sub

Private Sub ThrowIfNothing(ByVal Target As Object)
    If Target Is Nothing Then Err.Raise 5, TypeName(Me), "Argument cannot be a null reference."
End Sub

Private Sub ThrowIfSet(ByVal Target As Object)
    If Not Target Is Nothing Then Err.Raise 5, TypeName(Me), "This reference is already set."
End Sub

Private Sub Resize()
    With this.SourceTable
        this.LastRowCount = .ListRows.Count
        this.LastColumnCount = .ListColumns.Count
    End With
End Sub

Private Sub TableSheet_Change(ByVal Target As Range)

    If Intersect(Target, SourceTable.DataBodyRange) Is Nothing Then Exit Sub

    Select Case True
    Case this.SourceTable.DataBodyRange.Columns.Count > this.LastColumnCount
        OnAddedNewColumn SourceTable.ListColumns(ListObjectUtilities.GetCellColumn(this.SourceTable, Target))
    Case this.SourceTable.DataBodyRange.Rows.Count > this.LastRowCount
        OnAddedNewRow SourceTable.ListRows(ListObjectUtilities.GetCellRow(this.SourceTable, Target))
    Case Else
        OnChanged Target
    End Select
    Resize
End Sub

Private Property Get ITable_SourceTable() As ListObject
    Set ITable_SourceTable = this.SourceTable
End Property

Class: TableManager

'@Folder("VBAProject")
'@PredeclaredId
Option Explicit
Private WithEvents MyTable As Table

Public Property Get TableEvents() As Table
    Set TableEvents = MyTable
End Property

Public Property Set TableEvents(ByVal value As Table)
    Set MyTable = value
End Property

Private Sub MyTable_AddedNewColumn(ByVal newColumn As ListColumn)
    MsgBox "Added new column " & newColumn.Range.Column
End Sub

Private Sub MyTable_AddedNewRow(ByVal newRow As ListRow)
    MsgBox "Added new row " & newRow.Range.Row
End Sub

Private Sub MyTable_Changed(ByVal cell As Range)
    MsgBox "Changed " & cell.Address
End Sub

Sample file

Answer 1

I tried to repro, but then found that relying on Worksheet.Activate to register the handler, tends to misbehave: sometimes you need to "wiggle" the sheet so it keeps up, especially if you're editing the code. Could be just that :)

Note that in order to be able to fire AddedNewRow, AddedNewColumn, or even RemovedRow or RemovedColumn, you'll need to constantly track the size of the table with a mix of Worksheet.Change and Worksheet.SelectionChange handlers.

Table class module:

'@Folder("VBAProject")
'@PredeclaredId
Option Explicit

Private WithEvents TableSheet As Excel.Worksheet

Private Type TTable
    SourceTable As ListObject
    LastRowCount As Long
    LastColumnCount As Long
End Type

Private this As TTable

Public Event Changed(ByVal cell As Range)
Public Event AddedNewRow(ByVal newRow As ListRow)
Public Event AddedNewColumn(ByVal newColumn As ListColumn)

Public Function Create(ByVal Source As ListObject) As Table
    With New Table
        Set .SourceTable = Source
        Set Create = .Self
    End With
End Function

Public Property Get Self() As Table
    Set Self = Me
End Property

Public Property Get SourceTable() As ListObject
    Set SourceTable = this.SourceTable
End Property

Public Property Set SourceTable(ByVal Value As ListObject)
    ThrowIfSet this.SourceTable
    ThrowIfNothing Value
    Set TableSheet = Value.Parent
    Set this.SourceTable = Value
    Resize
End Property

Friend Sub OnChanged(ByVal Target As Range)
    RaiseEvent Changed(Target)
End Sub

Friend Sub OnAddedNewRow(ByVal newRow As ListRow)
    RaiseEvent AddedNewRow(newRow)
End Sub

Friend Sub OnAddedNewColumn(ByVal newColumn As ListColumn)
    RaiseEvent AddedNewColumn(newColumn)
End Sub

Private Sub ThrowIfNothing(ByVal Target As Object)
    If Target Is Nothing Then Err.Raise 5, TypeName(Me), "Argument cannot be a null reference."
End Sub

Private Sub ThrowIfSet(ByVal Target As Object)
    If Not Target Is Nothing Then Err.Raise 5, TypeName(Me), "This reference is already set."
End Sub

Private Sub Resize()
    With this.SourceTable
        this.LastRowCount = .ListRows.Count
        this.LastColumnCount = .ListColumns.Count
    End With
End Sub

Private Sub TableSheet_Change(ByVal Target As Range)
    If Not (Target.ListObject Is SourceTable) Then Exit Sub
    OnChanged Target
    Resize
End Sub

Note that you can use the Is operator to determine whether Target.ListObject refers to the same object as SourceTable, instead of using Application.Intersect with ranges:

If Not (Target.ListObject Is SourceTable) Then Exit Sub

From there all we need is a class to handle this Changed event - I've put that in the Sheet1 code-behind here, but any class module will do (including a UserForm module):

Sheet1 worksheet module:

'@Folder("VBAProject")
Option Explicit
Private WithEvents MyTable As Table

Public Property Get TableEvents() As Table
    Set TableEvents = MyTable
End Property

Public Property Set TableEvents(ByVal value As Table)
    Set MyTable = value
End Property

Private Sub MyTable_Changed(ByVal cell As Range)
    MsgBox "Changed " & cell.Address
End Sub

The Table reference still needs to be Set somewhere - here in the Open handler of the host workbook:

ThisWorkbook workbook module:

'@Folder("VBAProject")
Option Explicit

Private Sub Workbook_Open()
    With Sheet1
        Set .TableEvents = Table.Create(.ListObjects(1))
    End With
End Sub

---

The next step would be to clean up the public interface returned by Table.Create - as it stands, things are pretty confusing and the Table interface is a bit bloated:

All these members will be available to Sheet1.TableEvents, unless we do something. What if we could only expose the members the client code really needs, like this?

With Rubberduck you can extract an interface by right-clicking anywhere in the Table class and selecting "Extract Interface" from the "Refactor" menu, and then pick the members to extract - here the SourceTable getter (we're not going to expose the setter!):

This creates a new private class (this will change in future releases) - make it PublicNotCreatable in the properties toolwindow (F4) if the interface was extracted out of a public class.

The refactoring will add Implements ITable at the top of the Table class (assuming you didn't rename the interface), and this member will be added:

Private Property Get ITable_SourceTable() As ListObject
    Err.Raise 5 'TODO implement interface member
End Property

All you need to do is to supply the implementation:

Private Property Get ITable_SourceTable() As ListObject
    Set ITable_SourceTable = this.SourceTable
End Property

And now Table.Create can return the ITable abstraction:

Public Function Create(ByVal Source As ListObject) As ITable