Managing Excel Tables (ListObjects) with OOP Approach

Question

Objective:

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

---

Possible interactions:

• Update an existing Excel table
  • Add rows/columns to the table
  • Update a cell or a range of cells
  • Delete rows/columns to the table
  • Add a new Excel table
• Delete an Excel table
• Add a new Excel table

---

Specifications:

• Actions that are executed depend on the sheet that the table (ListObject) is located, i.e., if table is located in sheet x the Action that is executed should be generic action and if table is located in sheet y the Action that is executed should be create a task
• Actions depend on what is happening with the table, i.e., there should be an Action for the event of Adding rows and a different one for Deleting rows
• Actions should know what triggered them, e.g., Sheet, Table and Cell
• If user adds a new Table to a Sheet it should also respond to the Actions performed in it's cells

---

Code design standards:

• Use classes
• Use interfaces
• Implement strategy patterns

• Implement factory patterns <- This one I still don't understand quite well how to apply the concept

• Implement Unit tests <- This one I'm far from understanding

---

Sample use case #1:

• User modifies a cell or a range inside an Excel Table
  • Directly edit a cell
  • Copy paste a cell or a range
  • Use autofill from a cell and copy it to the next one (this couldn't find how to respond)
• An action is executed:
  • Program displays what was the previous value and the new value in the modified cell

Sample use case #2:

• User adds a new Excel Table (ListObject) to SheetY
• User modifies a cell in the new Excel Table
• An action is executed:
  • Program displays what was the previous value and the new value in the modified cell

Sample use case #3:

• User deletes an Excel Table (ListObject) from SheetY
• User modifies a cell in another Excel Table
• An action is executed:
  • Program displays what was the previous value and the new value in the modified cell

---

Would appreciate your review to find out:

1. If code design expectations are correctly implemented
2. How to implement a factory pattern (if it's useful in this case)
3. How to implement unit tests
4. If this approach is efficient (e.g. the way I'm handling how to store the table range previous values)
5. Any other insight you may consider

---

Reference

• Rubberduck-VBA blog
  • OOP Battleship Part 1: The Patterns
  • Factories: Parameterized Object Initialization
  • Private this As TSomething
  • How to unit test VBA code?
  • OOP VBA pt.1: Debunking Stuff
  • OOP VBA pt.2: Factories and Cheap Hotels
• Answers related to these subjects from Mathieu Guindon
  • Tags vba and object-oriented

---

Current file

You can download the demo file from here

File structure:

File structure

• SheetX contains a table (ListObject) called TableX
• SheetY contains two tables (ListObjects) called TableY1 and TableY2

---

Code

Code has annotations from Rubberduck add-in

If you don't have Rubberduck installed you can:

• Go and download it now...this is a must when you're developing in VBA!...and follow these instructions - Special thanks to Mathieu and his team ;)
• You must follow these instructions to set the predeclared attribute to true in the corresponding classes (look for "where to put it" in the article)

Rubberduck code explorer view

Components

Sheet: SheetX

'@Version(1)
'@Folder("App.TableTest")
Option Explicit
' Copywrite (C) 2019 Ricardo Diaz
' This file is distributed under the GPL-3.0 license
' Obtain a copy of the GPL-3.0 license <http://opensource.org/licenses/GPL-3.0>
Private newAppTables As ITables
Private Sub Worksheet_Activate()
 InitializeTablesGeneric
End Sub
Private Sub Worksheet_Deactivate()
 If Not newAppTables Is Nothing Then
 newAppTables.RemoveTables
 Set newAppTables = Nothing
 End If
End Sub
Private Sub InitializeTablesGeneric()
 On Error GoTo CleanFail
 Dim TableActions As Collection
 Dim ActionUpdate As TableActionGeneric
 Set TableActions = New Collection
 Set ActionUpdate = New TableActionGeneric
 TableActions.Add ActionUpdate, "Update"
 If newAppTables Is Nothing Then
 Set newAppTables = Tables.Create(TableActions, Me)
 End If
CleanExit:
 Exit Sub
CleanFail:
 Stop: Resume CleanExit
End Sub

Sheet: SheetY

'@Version(1)
'@Folder("App.TableTest")
Option Explicit
' Copywrite (C) 2019 Ricardo Diaz
' This file is distributed under the GPL-3.0 license
' Obtain a copy of the GPL-3.0 license <http://opensource.org/licenses/GPL-3.0>
Private newAppTables As ITables
Private Sub Worksheet_Activate()
 InitializeTablesCreateTask
End Sub
Private Sub Worksheet_Deactivate()
 If Not newAppTables Is Nothing Then
 newAppTables.RemoveTables
 Set newAppTables = Nothing
 End If
End Sub
Private Sub InitializeTablesCreateTask()
 On Error GoTo CleanFail
 Dim TableActions As Collection
 Dim ActionUpdate As TableActionUpdateCreateTask
 Set TableActions = New Collection
 Set ActionUpdate = New TableActionUpdateCreateTask
 TableActions.Add ActionUpdate, "Update"
 If newAppTables Is Nothing Then
 Set newAppTables = Tables.Create(TableActions, Me)
 End If
CleanExit:
 Exit Sub
CleanFail:
 Stop: Resume CleanExit
End Sub

Class: Tables

'@Folder("App.Tables")
Option Explicit
'@PredeclaredId
Private Type TTables
 Sheet As Worksheet
 Tables As Collection
 TableManagerActions As Collection
 Counter As Long
End Type
Private this As TTables
Implements ITables
Public Property Get Tables() As Collection
 Set Tables = this.Tables
End Property
Friend Property Set Tables(ByVal Value As Collection)
 Set this.Tables = Value
End Property
Public Property Get TableManagerActions() As Collection
 Set TableManagerActions = this.TableManagerActions
End Property
Friend Property Set TableManagerActions(ByVal Value As Collection)
 Set this.TableManagerActions = 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 Members
' --------------
'
Public Property Get Self() As Tables
 Set Self = Me
End Property
'
' Public Methods
' ---------------
'
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 Tables = New Collection
 For Each evalTable In Sheet.ListObjects
 AddNewTable evalTable
 Next evalTable
End Sub
Private Sub AddNewTable(ByVal evalTable As ListObject)
 Dim NewTable As Table
 Set NewTable = Table.Create(TableManagerActions, evalTable)
 Tables.Add Item:=NewTable, Key:=evalTable.name
End Sub
Public Sub RemoveTables()
 Dim evalTable As ListObject
 For Each evalTable In Sheet.ListObjects
 Tables.Remove evalTable.name
 Next evalTable
End Sub
Public Function Create(ByVal Actions As Collection, ByVal SourceSheet As Worksheet) As ITables
 With New Tables
 Set .TableManagerActions = Actions
 Set .Sheet = SourceSheet
 Set Create = .Self
 .AddTables
 End With
End Function
Private Sub ITables_AddTables()
 AddTables
End Sub
Private Property Get ITables_Counter() As Long
 ITables_Counter = this.Counter
End Property
Private Sub ITables_RemoveTables()
 RemoveTables
End Sub

Class (Interface): ITables

'@Folder("App.Tables")
Option Explicit
Public Property Get Counter() As Long
End Property
Public Sub AddTables()
End Sub
Public Sub RemoveTables()
End Sub

Class: Table

'@Folder("App.Tables")
Option Explicit
'@PredeclaredId
Private Type TListObjectProtector
 RefTable As ListObject
 TableManagerActions As Collection
 TableValues As Variant
 RowsCount As Long
 ColumnsCount As Long
 PreviousRowsCount As Long
End Type
Private this As TListObjectProtector
'@MemberAttribute VB_VarHelpID, -1
Private WithEvents appExcel As Excel.Application
Public Property Get RefTable() As ListObject
 Set RefTable = this.RefTable
End Property
Public Property Set RefTable(ByVal objectRef As ListObject)
 Set this.RefTable = objectRef
End Property
Public Property Get TableManagerActions() As Collection
 Set TableManagerActions = this.TableManagerActions
End Property
Friend Property Set TableManagerActions(ByVal Value As Collection)
 Set this.TableManagerActions = Value
End Property
Public Property Get TableValues() As Variant
 TableValues = this.TableValues
End Property
Friend Property Let TableValues(ByVal Value As Variant)
 this.TableValues = Value
End Property
Public Property Get RowsCount() As Long
 RowsCount = this.RowsCount
End Property
Friend Property Let RowsCount(ByVal Value As Long)
 this.RowsCount = Value
End Property
Public Property Get ColumnsCount() As Long
 ColumnsCount = this.ColumnsCount
End Property
Friend Property Let ColumnsCount(ByVal Value As Long)
 this.ColumnsCount = Value
End Property
Public Property Get Self() As Table
 Set Self = Me
End Property
'
' Private Methods
' ---------------
'
Private Function GetAction() As String
 Select Case True
 Case RowsCount < RefTable.DataBodyRange.Rows.Count Or ColumnsCount < RefTable.ListColumns.Count
 GetAction = "Add"
 Case RowsCount > RefTable.DataBodyRange.Rows.Count Or ColumnsCount > RefTable.ListColumns.Count
 GetAction = "Delete"
 Case RowsCount = RefTable.DataBodyRange.Rows.Count And ColumnsCount = RefTable.ListColumns.Count
 GetAction = "Update"
 End Select
End Function
Private Sub LoadFromRange(ByVal Target As Range)
 Dim evalRange As Range
 Set evalRange = Intersect(Target, RefTable.DataBodyRange)
 If Not evalRange Is Nothing Then
 TableValues = RangeUtilities.RangeToArray(RefTable.DataBodyRange, False)
 End If
 ColumnsCount = RefTable.ListColumns.Count
 RowsCount = RefTable.DataBodyRange.Rows.Count
End Sub
Private Sub ProcessRange(ByVal Target As Range)
 Select Case GetAction
 Case "Add"
 MsgBox "Add"
 Case "Delete"
 MsgBox "delete"
 Case "Update"
 UpdateRange Target, "Update"
 End Select
End Sub
Private Sub UpdateRange(ByVal Target As Range, ByVal Action As String)
 Dim evalRange As Range
 Dim EvalCell As Range
 Dim previousValue As Variant
 Dim evalRow As Long
 Dim evalColumn As Long
 Set evalRange = Intersect(Target, RefTable.DataBodyRange)
 If evalRange Is Nothing Then Exit Sub
 For Each EvalCell In Target
 evalRow = ListObjectUtilities.GetCellRow(RefTable, EvalCell)
 evalColumn = ListObjectUtilities.GetCellColumn(RefTable, EvalCell)
 If IsArray(TableValues) Then
 previousValue = TableValues(evalRow, evalColumn)
 Else
 previousValue = TableValues
 End If
 If previousValue <> EvalCell.Value2 Then
 ProcessCell EvalCell, EvalCell.Value2, previousValue, Action
 End If
 Next EvalCell
End Sub
Private Sub ProcessCell(ByVal EvalCell As Range, ByVal CurrentValue As Variant, ByVal previousValue As Variant, ByVal Action As String)
 Dim strategy As ITableAction
 Set strategy = TableManagerActions.Item(Action)
 strategy.Run EvalCell, CurrentValue, previousValue
End Sub
Public Function Create(ByVal Actions As Collection, ByVal Table As ListObject) As Table
 With New Table
 Set .TableManagerActions = Actions
 Set .RefTable = Table
 .ColumnsCount = .RefTable.ListColumns.Count
 .RowsCount = .RefTable.DataBodyRange.Rows.Count
 Set Create = .Self
 End With
End Function
Private Sub Class_Initialize()
 Set appExcel = Excel.Application
 Set TableManagerActions = New Collection
End Sub
Private Sub Class_Terminate()
 Set Table = Nothing
 Set appExcel = Nothing
 Set TableManagerActions = Nothing
End Sub
Private Sub appExcel_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 Dim evalRange As Range
 On Error Resume Next
 LogAction Sh.name, RefTable.name, "Change"
 On Error GoTo 0
 If RefTable Is Nothing Or Not ObjectUtilities.IsConnected(RefTable) Then Exit Sub
 If Not Sh Is RefTable.Parent Then Exit Sub
 Set evalRange = Intersect(Target, RefTable.DataBodyRange)
 If Not evalRange Is Nothing Then
 ProcessRange Target
 End If
End Sub
Private Sub appExcel_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 Dim evalRange As Range
 On Error Resume Next
 LogAction Sh.name, RefTable.name, "SelectionChange"
 On Error GoTo 0
 If RefTable Is Nothing Or Not ObjectUtilities.IsConnected(RefTable) Then Exit Sub
 If Not Sh Is RefTable.Parent Then Exit Sub
 Set evalRange = Intersect(Target, RefTable.DataBodyRange)
 If Not evalRange Is Nothing Then
 LoadFromRange Target
 End If
End Sub
Private Sub LogAction(ByVal SheetName As String, ByVal TableName As String, ByVal ActionName As String)
 If SheetName = "Logger" Then Exit Sub
 Application.EnableEvents = False
 Logger.Cells(Logger.Rows.Count, "A").End(xlUp).Offset(1, 0).Value2 = SheetName
 Logger.Cells(Logger.Rows.Count, "B").End(xlUp).Offset(1, 0).Value2 = TableName
 Logger.Cells(Logger.Rows.Count, "C").End(xlUp).Offset(1, 0).Value2 = ActionName
 Application.EnableEvents = True
End Sub

Class (Interface): ITableAction

'@Version(1)
'@Folder("App.Tables")
Option Explicit
' Copywrite (C) 2019 Ricardo Diaz
' This file is distributed under the GPL-3.0 license
' Obtain a copy of the GPL-3.0 license <http://opensource.org/licenses/GPL-3.0>
Public Sub Run(ByVal EvalCell As Range, ByVal CurrentValue As Variant, ByVal previousValue As Variant)
End Sub

Class: TableActionGeneric

'@Version(1)
'@Folder("App.Tables.Actions")
Option Explicit
' Copywrite (C) 2019 Ricardo Diaz
' This file is distributed under the GPL-3.0 license
' Obtain a copy of the GPL-3.0 license <http://opensource.org/licenses/GPL-3.0>
Implements ITableAction
Private Sub ITableAction_Run(ByVal EvalCell As Range, ByVal CurrentValue As Variant, ByVal previousValue As Variant)
 MsgBox "Generic Action in table: " & EvalCell.ListObject.name & " from: " & previousValue & " To: " & CurrentValue & " in Cell: " & EvalCell.Address
End Sub

Class: TableActionUpdateCreateTask

'@Version(1)
'@Folder("App.Tables.Actions")
Option Explicit
' Copywrite (C) 2019 Ricardo Diaz
' This file is distributed under the GPL-3.0 license
' Obtain a copy of the GPL-3.0 license <http://opensource.org/licenses/GPL-3.0>
Implements ITableAction
Private Sub ITableAction_Run(ByVal EvalCell As Range, ByVal CurrentValue As Variant, ByVal previousValue As Variant)
 MsgBox "CreateTask Action in table: " & EvalCell.ListObject.name & " from: " & previousValue & " To: " & CurrentValue & " in Cell: " & EvalCell.Address
End Sub

Components - Utilities -

Class: ListObjectUtilities

'@Version(1)
'@Folder("Framework.Utilities")
Option Explicit
'@PredeclaredId
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
' ----------------------------------------------------------------
' Procedure Name: AgregarReferenciar
' Purpose: Agregar una tabla estructurada para registrar información resultados
' Procedure Kind: Function
' Procedure Access: Public
' Parameter targetSheetResultados (Worksheet): targetSheet donde se almacena la tabla
' Parameter tableName (String): Nombre de la tabla
' Parameter ColumnList (Variant): Listado con nombres de columnas
' Return Type: ListObject
' Author: RicardoDiaz
' Date: 10/09/2019
' ----------------------------------------------------------------
'@Ignore AssignedByValParameter, ProcedureNotUsed
Public Function AddAndReference(ByVal TableName As String, Optional ByVal ColumnList As Variant, Optional ByVal TargetCell As Range, Optional ByVal ClearTableContents As Boolean = False, Optional ByVal TableStyleName As String) As ListObject
 Dim ExcelTable As ListObject
 If Exists(TableName) = False Then
 If TargetCell Is Nothing Then
 Set TargetCell = Application.InputBox(Prompt:= _
 "La tabla " & TableName & " no existe, seleccione una ubicación para crearla", _
 title:="Defina la ubicación", Type:=8)
 End If
 ' Agregar tabla estructurada
 Set ExcelTable = TargetCell.Parent.ListObjects.Add(SourceType:=xlSrcRange, source:=TargetCell)
 With ExcelTable
 .name = TableName
 ExcelTable.Resize .Range.Resize(, UBound(ColumnList) + 1)
 .HeaderRowRange.Value2 = ColumnList
 End With
 Else
 Set ExcelTable = Range(TableName).ListObject
 End If
 If TableStyleName <> vbNullString Then
 ExcelTable.TableStyle = TableStyleName
 End If
 If ClearTableContents = True Then
 If Not ExcelTable.DataBodyRange Is Nothing Then
 ExcelTable.DataBodyRange.Delete
 End If
 End If
 Set AddAndReference = ExcelTable
End Function
'@Ignore ProcedureNotUsed
Public Function AddAndReferenceRow(ByVal ExcelTable As ListObject, ByVal ColumnValues As Variant) As ListRow
 Dim newRow As ListRow
 Dim Counter As Long
 Set newRow = ExcelTable.ListRows.Add
 With newRow
 For Counter = 0 To UBound(ColumnValues)
 .Range(Counter + 1) = ColumnValues(Counter)
 Next Counter
 End With
 Set AddAndReferenceRow = newRow
End Function
'@Ignore ProcedureNotUsed
Public Function Exists(ByVal ListObjectName As String) As Boolean
 Dim evalListObject As ListObject
 On Error Resume Next
 Set evalListObject = Range(ListObjectName).ListObject
 On Error GoTo 0
 Exists = Not evalListObject Is Nothing
End Function
'@Ignore ProcedureNotUsed
Public Function GetRowByCriteria(ByVal ExcelTable As ListObject, ByVal Column1Header As String, _
 ByVal Column1Criteria As String, _
 Optional ByVal Column2Header As String, _
 Optional ByVal Column2Criteria As String, _
 Optional ByVal Column3Header As String, _
 Optional ByVal Column3Criteria As String) As ListRow
 Dim evalRow As ListRow
 Dim matchedRow As ListRow
 For Each evalRow In ExcelTable.DataBodyRange.ListObject.ListRows
 If Column2Header = vbNullString And Column3Header = vbNullString Then
 If (Intersect(evalRow.Range, ExcelTable.ListColumns(Column1Header).Range).Value = Column1Criteria) = True Then Set matchedRow = evalRow: Exit For
 ElseIf Column2Header <> vbNullString And Column3Header = vbNullString Then
 If (Intersect(evalRow.Range, ExcelTable.ListColumns(Column1Header).Range).Value = Column1Criteria) And _
 (Intersect(evalRow.Range, ExcelTable.ListColumns(Column2Header).Range).Value = Column2Criteria) = True Then Set matchedRow = evalRow: Exit For
 ElseIf Column2Header <> vbNullString And Column3Header <> vbNullString Then
 If (Intersect(evalRow.Range, ExcelTable.ListColumns(Column1Header).Range).Value = Column1Criteria) And _
 (Intersect(evalRow.Range, ExcelTable.ListColumns(Column2Header).Range).Value = Column2Criteria) And _
 (Intersect(evalRow.Range, ExcelTable.ListColumns(Column3Header).Range).Value = Column3Criteria) = True Then Set matchedRow = evalRow: Exit For
 End If
 Next evalRow
 Set GetRowByCriteria = matchedRow
End Function
'@Ignore ProcedureNotUsed
Public Function HasExternalConnection(ByVal ListObjectName As String) As Boolean
 Dim evalSheet As Worksheet
 Dim evalListObject As ListObject
 For Each evalSheet In ThisWorkbook.Worksheets
 For Each evalListObject In evalSheet.ListObjects
 If evalListObject.name = ListObjectName Then
 If evalListObject.SourceType = xlSrcModel Or evalListObject.SourceType = xlSrcExternal Or evalListObject.SourceType = xlSrcQuery Then
 HasExternalConnection = True
 Exit For
 End If
 End If
 Next evalListObject
 Next evalSheet
End Function
'@Ignore ProcedureNotUsed
Public Sub DeleteRowsByCriteria(ByVal ExcelTable As ListObject, ByVal Column1Header As String, _
 ByVal Column1Criteria As String, _
 Optional ByVal Column2Header As String, _
 Optional ByVal Column2Criteria As String, _
 Optional ByVal Column3Header As String, _
 Optional ByVal Column3Criteria As String)
 Dim evalRow As ListRow
 Dim Counter As Long
 Dim totalRows As Long
 Dim deleteRow As Boolean
 totalRows = ExcelTable.ListRows.Count
 For Counter = totalRows To 1 Step -1
 Set evalRow = ExcelTable.ListRows(Counter)
 If Column2Header = vbNullString And Column3Header = vbNullString Then
 deleteRow = (Intersect(evalRow.Range, ExcelTable.ListColumns(Column1Header).Range).Value = Column1Criteria)
 ElseIf Column2Header <> vbNullString And Column3Header = vbNullString Then
 deleteRow = (Intersect(evalRow.Range, ExcelTable.ListColumns(Column1Header).Range).Value = Column1Criteria) And _
 (Intersect(evalRow.Range, ExcelTable.ListColumns(Column2Header).Range).Value = Column2Criteria)
 ElseIf Column2Header <> vbNullString And Column3Header <> vbNullString Then
 deleteRow = (Intersect(evalRow.Range, ExcelTable.ListColumns(Column1Header).Range).Value = Column1Criteria) And _
 (Intersect(evalRow.Range, ExcelTable.ListColumns(Column2Header).Range).Value = Column2Criteria) And _
 (Intersect(evalRow.Range, ExcelTable.ListColumns(Column3Header).Range).Value = Column3Criteria)
 End If
 If deleteRow = True Then
 evalRow.Delete
 End If
 Next Counter
End Sub

Class: ObjectUtilities

'@Folder("Framework.Utilities")
Option Explicit
'@PredeclaredId
Private Const C_ERR_NO_ERROR = 0&
Private Const C_ERR_OBJECT_VARIABLE_NOT_SET = 91&
Private Const C_ERR_OBJECT_REQUIRED = 424&
Private Const C_ERR_DOES_NOT_SUPPORT_PROPERTY = 438&
Private Const C_ERR_APPLICATION_OR_OBJECT_ERROR = 1004&
Public Function IsConnected(ByVal Obj As Object) As Boolean
 ' Credits: http://www.cpearson.com/excel/ConnectedObject.htm
 ' Adapted by: Ricardo Diaz
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' IsConnected
 ' By Chip Pearson, [email protected], www.cpearson.com
 ' http://www.cpearson.com/excel/ConnectedObject.htm
 '
 ' This procedure determines whether an object type variable is still connected
 ' to its target. An object variable can become disconnected from its target
 ' when the target object is destroyed. For example, the following code will
 ' raise an automation error because the target of the variable WS had been
 ' destoryed.
 '
 ' Dim WS As Worksheet
 ' Set WS = ActiveSheet
 ' ActiveSheet.Delete
 ' Debug.Print WS.Name
 '
 ' This code will fail on the "Debug.Print WS.Name" because the worksheet to
 ' which WS referenced was destoryed. It is important to note that WS will NOT
 ' be set to Nothing when the worksheet is deleted.
 '
 ' This procedure attempts to call the Name method of the Obj variable and
 ' then tests the result of Err.Number. We'll get the following error
 ' numbers:
 ' C_ERR_NO_ERROR
 ' No error occurred. We successfully retrieved the Name
 ' property. This indicates Obj is still connected to its
 ' target. Return TRUE.
 '
 ' C_ERR_OBJECT_VARIABLE_NOT_SET
 ' We'll get this error if the Obj variable has been
 ' disconnected from its target. Return FALSE.
 '
 ' C_ERR_DOES_NOT_SUPPORT_PROPERTY
 ' We'll get this error if the Obj variable does not have
 ' a name property. In this case, the Obj variable is still
 ' connected to its target. Return True.
 '
 ' C_ERR_APPLICATION_OR_OBJECT_ERROR
 ' This is a generic error message. If we get this error, we need to
 ' do further testing to get the connected state.
 '
 ' These are the only values that Err.Number should return. If we receive
 ' another error, err on the side of caution and return False.
 '
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 '@Ignore VariableNotUsed
 Dim NameProp As String
 '@Ignore VariableNotUsed
 Dim ParentObj As Object
 On Error Resume Next
 Err.Clear
 NameProp = Obj.name
 On Error GoTo 0
 Select Case Err.Number
 Case C_ERR_NO_ERROR
 ' We'll get this result if we retrieve the Name property of Obj.
 ' Obj is connected.
 IsConnected = True
 Case C_ERR_DOES_NOT_SUPPORT_PROPERTY
 ' We'll get this result if Obj does not have a name property. This
 ' still indicates that Obj is connected.
 IsConnected = True
 Case C_ERR_OBJECT_VARIABLE_NOT_SET
 ' This indicates that Obj was Nothing, which we will treat
 ' as disconnected. If you want Nothing to indicate connected,
 ' test the variable Is Nothing before calling this procedure.
 IsConnected = False
 Case C_ERR_OBJECT_REQUIRED
 ' This indicates the object is disconnected. Return False
 IsConnected = False
 Case C_ERR_APPLICATION_OR_OBJECT_ERROR
 ' This error may occur when the object is either connected or disconnected.
 ' In this case, attempt to get the Parent property of the object.
 Err.Clear
 Set ParentObj = Obj.Parent
 Select Case Err.Number
 Case C_ERR_NO_ERROR
 ' we succuesfully got the parent object. Obj is connected.
 IsConnected = True
 Case C_ERR_DOES_NOT_SUPPORT_PROPERTY
 ' we'll get this error if Obj does not have a Parent property. This
 ' still indicates that Obj is connected.
 IsConnected = True
 Case C_ERR_OBJECT_VARIABLE_NOT_SET
 ' we'll get this error if Obj is disconnected
 IsConnected = False
 Case Else
 IsConnected = False
 End Select
 Case Else
 ' we should never get here, but return False if we do
 IsConnected = False
 End Select
End Function

Class: RangeUtilities

'@Version(1)
'@PredeclaredId
'@Folder("Framework.Utilities")
Option Explicit
'@Ignore ProcedureNotUsed
Public Function ToString(ByVal evalRange As Range, Optional ByVal separator As String) As String
 Dim EvalCell As Range
 Dim result As String
 For Each EvalCell In evalRange.Cells
 result = result & EvalCell.Value & separator
 Next EvalCell
 ToString = Left$(result, Len(result) - Len(separator))
End Function
'@Ignore ProcedureNotUsed
Public Function GetRangeName(ByVal Target As Range) As String
 On Error Resume Next
 GetRangeName = Target.name.name
 On Error GoTo 0
End Function
'@Ignore ProcedureNotUsed
Public Function RangeToArray(ByVal evalRange As Range, ByVal Transpose As Boolean) As Variant
 ' When Transpose = true the result will be a 1D array if there is only one row or one column
 If Transpose = True Then
 Select Case True
 Case evalRange.Rows.Count = 1 And evalRange.Columns.Count > 1
 RangeToArray = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(evalRange))
 Case evalRange.Rows.Count > 1 And evalRange.Columns.Count = 1
 RangeToArray = Application.WorksheetFunction.Transpose(evalRange)
 Case Else
 RangeToArray = evalRange.Value2
 End Select
 Else
 RangeToArray = evalRange.Value2
 End If
End Function

Answer 1

On the whole nice work! This is actually a problem I've looked at in the past, and as a result I'd like to review the approach you've taken and the API/ way users can interact with your code.

---

As I understand it you have 3 main classes

1. Tables - responsible for instantiating a collection of Table objects (with some automagic methods to allow client code to attempt to keep this collection in sync so it reflects what's on the sheet)
2. ITableAction implementations which are essentially callback functions with a strict interface that are triggered by updates to the tables
3. The Table class - what actually wraps ListObjects and converts Application level events into triggers to run those TableActions

The rest is mostly just utility stuff and example code. Now I'd argue that classes 1. (mostly) and 2. are actually redundant and making your life a lot harder, let's take a step back and see how the approach could perhaps be simplified and made more VBA-idiomatic.

---

Starting with the constructor for the Table class:

Public Function Create(ByVal Actions As Collection, ByVal Table As ListObject) As Table
 With New Table
 Set .TableManagerActions = Actions
 Set .RefTable = Table
 .ColumnsCount = .RefTable.ListColumns.Count
 .RowsCount = .RefTable.DataBodyRange.Rows.Count
 Set Create = .Self
 End With
End Function
Private Sub Class_Initialize()
 Set appExcel = Excel.Application
 Set TableManagerActions = New Collection
End Sub

The Create method takes a Collection of actions, so why does the Class_Initialize method need to New one up?

And what about that appExcel - in this case you're lucky that Excel.Application will probably always refer to the same object, but better to supply that in the Create method too (dependency injection) - that will also make it easier to Unit Test as you can use a mock Excel.Application to raise events when you are testing.

---

While we're here, do we even need a reference to the Application? The only events you hook into are appExcel_SheetChange and appExcel_SheetSelectionChange - since a ListObject can never span multiple worksheets, why not declare

Private WithEvents listObjectParentSheet As Excel.Worksheet

and use the sheet level Change and SelectionChange events instead?

Better still, you can then use

Set listObjectParentSheet = Table.Parent

in the constructor to get the worksheet reference without passing it explicitly

---

I don't really like these names:

.ColumnsCount = .RefTable.ListColumns.Count
.RowsCount = .RefTable.DataBodyRange.Rows.Count

It looks like they might be the current value when really they are a cached value that's used in GetAction to see whether the dimensions of the table have changed. So name them as such: cachedColumnCount / previousColumnCount (drop the s too)

---

Now what about those actions. As I say, currently they are being used as callbacks; that is GetAction enumerates various changes to the table, ProcessRangeuses these enumerated action strings to call various routines which ultimately lead to invoking the action somewhere down the line:

Set strategy = TableManagerActions.Item(Action)
strategy.Run EvalCell, CurrentValue, previousValue

VBA already has a syntax for dealing with callbacks - Events. Instead of calling ITableAction_Run, your Table class could raise a custom Add or Delete or Update event. This way client code can listen for changes to the table, and hook any event handlers it fancies. You can then have different methods for handling events of different tables and don't need to construct a load of action objects.

In summary, the Table class then does the following things:

1. Listen to the encapsulated ListObject's parent sheet for any changes
2. Check whether these changes affect the encapsulated table, if so determine what kind of change occured (column added, row added, cell changed, table moved, row/column deleted etc.) by comparing to a cached version of the table.
3. Generate any useful data you want the event listener to know about (If a row was added, which ListRow was it? If a cell was updated, then which cell and what was its previous value? If the table was moved, where from and to etc.)
4. RaiseEvent ChangeKind(usefulData) to notify any listeners of the change and run their event handlers (instead of calling an ITableAction directly)

---

With those changes there will no longer be a need for TableActions. There will also be no TableManagerActions to save in the Tables collection, and therefore nothing in common between Table objects in the Tables collection except that they all live on the same worksheet.

At this point I'd do away with the Tables class entirely - the AddAllTablesInSheet method can become a module function that takes a sheet as a parameter and spits out a simple collection of Table objects, or maybe passes them to a class that does the event listening and handling.

• Ricardo Diaz: Great insights! what you're suggesting simplificates the whole deal. thank you @greedo. I have really limited knowledge in events, so I'll try to implement them and post a follow up question to check if I correctly understood them.
• Ricardo Diaz: This is my follow up question. Again thanks for the time you spent reviewing my code. Would appreciate if you can have a look at the new code.