2
\$\begingroup\$

This is a follow up to this question

Objective:

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


Code incorporates:

  • Greedo's answer suggestions:
    • Listen to an encapsulated ListObject
    • Gather useful data to pass to the event raised when the ListObject was changed
    • Raise events according to the user interaction
  • Mathieu's help on this question

Remarks:

I combined Matt's solution but ended up with another class (Tables) to store the instances of each Table created so this could manage multiple tables in a Sheet, so I'm not sure if this part could be simplificated.


Questions:

  1. Could this be simplified in a single class?
  2. Is the SheetTable class required?
  3. Is there a way to unit test these classes? is there a benefit to do it? if someone can give me an example, would appreciate it. (I'm trying to learn that topic)
  4. Any suggestion to improve it is welcome

Sample file:

You can download the file with code from this link (read-only)


File structure:

Code tree

Code:

Sheet: Sheet1

Option Explicit

Private sheetTables As ITables

Private Sub Worksheet_Activate()
    Set sheetTables = Tables.Create(Me)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    sheetTables.AddTables
End Sub

Private Sub Worksheet_Deactivate()
    Set sheetTables = Nothing
End Sub

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)
    ' Used intersect to catch only the databodyrange, otherwise this could be Target.ListObject is SourceTable
    If Intersect(Target, SourceTable.DataBodyRange) Is Nothing Then Exit Sub

    Select Case True
    Case this.SourceTable.DataBodyRange.Columns.Count > this.LastColumnCount
        OnAddedNewColumn SourceTable.ListColumns(GetCellColumn(this.SourceTable, Target))
    Case this.SourceTable.DataBodyRange.Rows.Count > this.LastRowCount
        OnAddedNewRow SourceTable.ListRows(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


Private 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

Private 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: ITables

Option Explicit

Public Sub AddTables()
End Sub

Public Function Create(ByVal SourceSheet As Worksheet) As Tables
End Function

Class: Tables

'@Folder("VBAProject")

Option Explicit
'@PredeclaredId

Private WithEvents MyTable As Table

Private Type TTables
    Sheet As Worksheet
    sheetTables As Collection

    Counter As Long
End Type

Private this As TTables

Implements ITables

Public Property Get sheetTables() As Collection
    Set sheetTables = this.sheetTables
End Property

Friend Property Set sheetTables(ByVal Value As Collection)
    Set this.sheetTables = Value
End Property

Public Property Get Sheet() As Worksheet
    Set Sheet = this.Sheet
End Property

Friend Property Set Sheet(ByVal Value As Worksheet)
    Set this.Sheet = Value
End Property

Public Property Get Counter() As Long
    Counter = this.Counter
End Property

Friend Property Let Counter(ByVal Value As Long)
    this.Counter = Value
End Property

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

Public Sub AddTables()

    Select Case True
    Case Counter = 0 Or Counter > Sheet.ListObjects.Count

        AddAllTablesInSheet

    Case Sheet.ListObjects.Count > Counter

        AddNewTable Sheet.ListObjects(Sheet.ListObjects.Count)

    End Select

    Counter = Sheet.ListObjects.Count

End Sub

Private Sub AddAllTablesInSheet()

    Dim evalTable As ListObject

    Set sheetTables = New Collection

    For Each evalTable In Sheet.ListObjects
        AddNewTable evalTable
    Next evalTable

End Sub

Private Sub AddNewTable(ByVal evalTable As ListObject)
    Dim NewSheetTable As SheetTable

    Set NewSheetTable = New SheetTable
    Set NewSheetTable.TableEvents = Table.Create(evalTable)

    sheetTables.Add Item:=NewSheetTable, Key:=evalTable.Name

End Sub

Public Function Create(ByVal SourceSheet As Worksheet) As ITables
    With New Tables
        Set .Sheet = SourceSheet
        Set Create = .Self
        .AddTables
    End With
End Function


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


Private Sub ITables_AddTables()
    AddTables
End Sub

Private Function ITables_Create(ByVal SourceSheet As Worksheet) As Tables
    Set ITables_Create = Create(SourceSheet)
End Function

Class: SheetTable

'@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 table column in sheet column " & newColumn.Range.Column
End Sub

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

Private Sub MyTable_Changed(ByVal cell As Range)
    MsgBox "Changed " & cell.Address & " which belongs to the table: " & cell.ListObject.Name
End Sub

Code has annotations from Rubberduck add-in

Notes:

  • As Sheet's Activate event is not fired on Workbook Open (read this) you'd have to manage that situation or manually activate the sheet holding the tables.
\$\endgroup\$
2
\$\begingroup\$

I find relying on Sheet.Activate / Sheet.Deactivate to set/unset the sheetTables reference is rather frail, error-prone (miss an Activate event for whatever reason (Application.EnableEvents being toggled off, for example), and just like that the Change handler starts throwing error 91), and doesn't really make much sense: the table exists on Sheet1 as long as Sheet1 does, no?

Private Sub Worksheet_Change(ByVal Target As Range)
    sheetTables.AddTables
End Sub

In that case, then why do we need to re-create the wrapper every single time any cell is modified on that sheet? This method should run once, for the entire lifetime of the worksheet: I'd do that in a Workbook.Open handler.

When present, a factory method should be the first member listed, followed by the public members of the class' default interface.

Public Function Create(ByVal SourceSheet As Worksheet) As ITables
    With New Tables
        Set .Sheet = SourceSheet
        Set Create = .Self
        .AddTables
    End With
End Function

You wouldn't bury a C# class constructor at the bottom of the class; don't bury a VBA factory method at the bottom of the class... or worse, somewhere in the middle of it.

Note that the .AddTables member call is made against the Tables interface. ITables is weird:

Option Explicit

Public Sub AddTables()
End Sub

Public Function Create(ByVal SourceSheet As Worksheet) As Tables
End Function

Class modules that are intended to be used as abstract interfaces should have an @Interface annotation; Rubberduck's static code analysis will then treat it as such, whether or not the interfacec is actually implemented anywhere.

But the weird thing with this interface, is that it's exposing the factory method, which is normally invoked off the default instance of the concrete type... like you do here:

Private Sub Worksheet_Activate()
    Set sheetTables = Tables.Create(Me)
End Sub

A factory method on an abstract interface would be legit if we were looking at an Abstract Factory - but that's not what we have here, this factory method is yielding the concrete type (Tables) ...and yet the actual factory method you're using does yield the ITables abstraction.

AddTables doesn't belong on that interface either: it's an implementation detail of the Create factory method, which itself belongs on the concrete type - none of the members of ITables belong on ITables.

These would all feel right at home on that interface though:

Public Property Get sheetTables() As Collection
End Property

Public Property Get Sheet() As Worksheet
End Property

Public Property Get Counter() As Long
End Property

...with a reservation for sheetTables As Collection: exposing a Collection means the client code is able to .Add and .Remove items, and you certainly don't want to allow that. Consider exposing it as an indexed property instead:

Public Property Get SheetTable(ByVal index As Variant) As ITable
End Property

Now given a name or index, retrieve the ITable item and return it. Also consider exposing a NewEnum member (and yield sheetTables.[_NewEnum]) with an @Enumerator annotation (sync attributes through Rubberduck inspections), and then the client code will be able to iterate the items in this custom collection class, with an idiomatic For Each loop. The name Tables, pluralized, strongly suggests that it's a collection of tables.

Or you could introduce some ReadOnlyCollection class with a Create method that takes a ParamArray argument, with logic to initialize the encapsulated collection with the specified items (could be an array or collection - I'll leave the implementation up to the reader), and then there'd be no problem exposing such a read-only collection that can only be iterated.

Exposing the encapsulated Collection itself, breaks encapsulation.

Not sure what the purpose of this eval/Eval prefix is:

Private 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

Private 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

The objective clearly isn't related to preserving the camelCase or PascalCase of parameter names, so I'm left baffled as to why it's not just table and cell. Actually, since these members belong to Table which is wrappping a ListObject, ...I think the ListObject parameters should be removed - if these functions really belong in that class, then they should be working off the this.SourceTable instance field.

| improve this answer | |
\$\endgroup\$
  • 1
    \$\begingroup\$ Hi Mathieu. answering your question: why do we need to re-create the wrapper every single time any cell is modified on that sheet? I need it to handle new tables added (or removed) to the same sheet. I couldn't find another way to know they were added but to use the sheet's change event. \$\endgroup\$ – Ricardo Diaz Jan 13 at 18:35
  • \$\begingroup\$ Ah, yeah that makes more sense now. Was under the impression that all tables existed on their respective sheet at compile-time! \$\endgroup\$ – Mathieu Guindon Jan 13 at 18:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.