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
- Listen to an encapsulated
- 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:
- Could this be simplified in a single class?
- Is the
SheetTable
class required? - 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)
- Any suggestion to improve it is welcome
Sample file:
You can download the file with code from this link (read-only)
File structure:
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.