0
\$\begingroup\$

This is a follow up to this question and this question

Objective:

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

Code incorporates:

Mathieu's suggestions:

  • ITables: Refactored interface and it's implementation
  • Tables: Hide SheetTables collection and exposed as a SheetTable(item) property
  • Tables: Added NewEnum property (couldn't make it work)
  • Tables: Added DefaultMember (couldn't make it work)
  • All: Removed the eval prefix in variables

New features:

  • Handle events when TableSheet_Change:
    • Columns deleted
    • Rows deleted
    • Columns added (special case)
    • Rows added
    • Cells changed

Known issues:


Questions:

  1. Could this be simplified?
  2. Is there a way to unit test these classes? is there a benefit to do it?
  3. Any suggestion to improve it is welcome

Sample file:

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


File structure:

File structure

Code:

Sheet: Sample

'@Folder("Test")
Option Explicit
Private newTables As ITables
Private Sub Worksheet_Activate()
 InitTables
End Sub
Private Sub Worksheet_Deactivate()
 Set newTables = Nothing
End Sub
Private Sub InitTables()
 Set newTables = Tables.Create(Me)
End Sub

Class: Tables

'@Folder("TableManager")
'@PredeclaredId
Option Explicit
'@MemberAttribute VB_VarHelpID, -1
Private WithEvents SheetEvents As Excel.Worksheet
Private Type TTables
 Sheet As Worksheet
 SheetTables As Collection
 Counter As Long
End Type
Private this As TTables
Implements ITables
Public Function Create(ByVal SourceSheet As Worksheet) As ITables
 With New Tables
 Set .Sheet = SourceSheet
 Set Create = .Self
 .LoadTables
 End With
End Function
Public Property Get Self() As Tables
 Set Self = Me
End Property
'@Enumerator
Public Property Get NewEnum() As IUnknown
 Set NewEnum = this.SheetTables.[_NewEnum]
End Property
'@DefaultMember
Public Property Get SheetTable(ByVal index As Variant) As ITable
 Set SheetTable = this.SheetTables.Item(index).TableEvents
End Property
Private Property Get ITables_SheetTable(ByVal index As Variant) As ITable
 Set ITables_SheetTable = SheetTable(index)
End Property
Public Property Get Sheet() As Worksheet
 Set Sheet = this.Sheet
End Property
Friend Property Set Sheet(ByVal Value As Worksheet)
 Set SheetEvents = Value
 Set this.Sheet = Value
End Property
Private Property Get ITables_Sheet() As Worksheet
 Set ITables_Sheet = Sheet
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
Private Property Get ITables_Counter() As Long
 ITables_Counter = this.Counter
End Property
Public Sub LoadTables()
 If Not this.SheetTables Is Nothing Then Counter = this.SheetTables.Count
 Select Case True
 Case Counter = 0
 AddAllTablesInSheet
 Case Counter < Sheet.ListObjects.Count
 OnAddedTable Sheet.ListObjects(Sheet.ListObjects.Count)
 Case Counter > Sheet.ListObjects.Count
 OnDeletedTables
 End Select
 Counter = Sheet.ListObjects.Count
End Sub
Private Sub AddAllTablesInSheet()
 Dim Table As ListObject
 Set this.SheetTables = New Collection
 For Each Table In Sheet.ListObjects
 OnAddedTable Table
 Next Table
End Sub
Private Sub AddNewTable(ByVal NewTable As ListObject)
 Dim NewSheetTable As SheetTable
 Set NewSheetTable = New SheetTable
 Set NewSheetTable.TableEvents = Table.Create(NewTable)
 this.SheetTables.Add NewSheetTable, NewTable.Name
End Sub
Friend Sub OnAddedTable(ByVal NewTable As ListObject)
 AddNewTable NewTable
 'MsgBox "The " & NewTable.Name & " table was added"
End Sub
Friend Sub OnDeletedTables()
 Dim Counter As Long
 If this.SheetTables Is Nothing Then Exit Sub
 For Counter = this.SheetTables.Count To 1 Step -1
 If IsConnected(this.SheetTables.Item(Counter).TableEvents.SourceTable) = False Then
 Dim tableName As String
 Dim PreviousValues As Variant
 tableName = this.SheetTables.Item(Counter).TableEvents.Name
 PreviousValues = this.SheetTables.Item(Counter).TableEvents.PreviousValues
 OnDeletedTable tableName, PreviousValues
 this.SheetTables.Remove tableName
 End If
 Next Counter
End Sub
Friend Sub OnDeletedTable(ByVal DeletedTableName As String, ByVal PreviousValues As Variant)
 MsgBox "The table " & DeletedTableName & " was deleted and it had " & UBound(PreviousValues, 1) & " row(s) and " & UBound(PreviousValues, 2) & " column(s)"
End Sub
Private Sub SheetEvents_Change(ByVal Target As Range)
 LoadTables
End Sub
Private Sub SheetEvents_SelectionChange(ByVal Target As Range)
 LoadTables
End Sub

Class: Table

'@Folder("TableManager")
'@PredeclaredId
Option Explicit
'@MemberAttribute VB_VarHelpID, -1
Private WithEvents TableSheet As Excel.Worksheet
Private Type TTable
 SourceTable As ListObject
 UpdatedRange As Range
 AddedRange As Range
 LastRowCount As Long
 LastColumnCount As Long
 Name As String
 PreviousSelectionTableName As String
 PreviousRangeAddress As String
 PreviousRange As Range
 PreviousValues As Variant
 RowsAdded As Long
 ColumnsAdded As Long
 Action As String
End Type
Private this As TTable
Public Event Changed(ByVal cell As Range)
Public Event AddedNewRow(ByVal AddedRange As Range)
Public Event AddedNewColumn(ByVal AddedRange As Range)
Public Event DeletedRow(ByVal deletedTarget As Range)
Public Event DeletedColumn(ByVal deletedTarget As Range)
Implements ITable
Public Function Create(ByVal Source As ListObject) As ITable
 With New Table
 Set .SourceTable = Source
 .Name = Source.Name
 .PreviousRangeAddress = Source.Range.Address
 .PreviousValues = Source.Range.Value
 Set Create = .Self
 End With
End Function
Public Property Get Self() As Table
 Set Self = Me
End Property
Public Property Get Name() As String
 Name = this.Name
End Property
Public Property Let Name(ByVal Value As String)
 this.Name = Value
End Property
Public Property Get PreviousRange() As Range
 Set PreviousRange = TableSheet.Range(this.PreviousRangeAddress)
End Property
Public Property Get PreviousRangeAddress() As String
 PreviousRangeAddress = this.PreviousRangeAddress
End Property
Public Property Let PreviousRangeAddress(ByVal Value As String)
 this.PreviousRangeAddress = Value
End Property
Public Property Get PreviousValues() As Variant
 PreviousValues = this.PreviousValues
End Property
Public Property Let PreviousValues(ByVal Value As Variant)
 this.PreviousValues = Value
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
Private Property Get ITable_Name() As String
 ITable_Name = Name
End Property
Private Property Get ITable_SourceTable() As ListObject
 Set ITable_SourceTable = SourceTable
End Property
Friend Sub OnChanged()
 RaiseEvent Changed(this.UpdatedRange)
End Sub
Friend Sub OnAddedNewRow()
 RaiseEvent AddedNewRow(this.AddedRange)
End Sub
Friend Sub OnAddedNewColumn()
 RaiseEvent AddedNewColumn(this.AddedRange)
End Sub
Friend Sub OnDeletedRow(ByVal deletedTarget As Range)
 RaiseEvent DeletedRow(deletedTarget)
End Sub
Friend Sub OnDeletedColumn(ByVal deletedTarget As Range)
 RaiseEvent DeletedColumn(deletedTarget)
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 RecordPreviousValues(ByVal Target As Range)
 If IsConnected(this.SourceTable) = False Then Exit Sub
 If TypeName(Target.ListObject) = "ListObject" Then this.PreviousSelectionTableName = Target.ListObject.Name
 this.PreviousRangeAddress = SourceTable.Range.Address
 this.PreviousValues = SourceTable.Range.Value
End Sub
Private Sub RecordChange(ByVal Target As Range)
 this.Action = GetAction
 Set this.UpdatedRange = Intersect(Target, PreviousRange)
 Set this.AddedRange = Target
End Sub
Private Sub ResizeAndRecordPrevious(ByVal Target As Range)
 Resize
 RecordPreviousValues Target
End Sub
Private Sub Resize()
 With this.SourceTable
 this.LastRowCount = .ListRows.Count
 this.LastColumnCount = .ListColumns.Count
 End With
End Sub
'@Description("When a table's range is changed, it combines an existing range and a new range, this handles both cases")
Private Sub ProcessRange()
 If Not this.UpdatedRange Is Nothing Then OnChanged
 If Not this.AddedRange Is Nothing Then
 Select Case this.Action
 Case "columns added"
 OnAddedNewColumn
 Case "rows added"
 OnAddedNewRow
 End Select
 End If
End Sub
Private Sub TableSheet_Activate()
 RecordPreviousValues Selection
End Sub
Private Sub TableSheet_Change(ByVal Target As Range)
 ' This event happens for every table that is in the sheet
 ' Events order interchangeable:
 ' Columns added | Headers changed | Cells changed
 ' Rows added | Cells changed
 Dim changedRange As Range
 Dim Action As String
 If Not IsConnected(this.SourceTable) Then Exit Sub
 Action = GetAction
 Select Case True
 Case Action = "columns deleted"
 Set changedRange = Intersect(Target, PreviousRange)
 OnDeletedColumn changedRange
 ResizeAndRecordPrevious changedRange
 Case Action = "rows deleted"
 Set changedRange = Intersect(Target, PreviousRange)
 OnDeletedRow changedRange
 ResizeAndRecordPrevious changedRange
 Case Action = "columns added" And this.ColumnsAdded = 0
 ' If columns are added two scenarios may happen:
 ' 1. If range added includes column headers:
 ' Three events are fired: 1) When each cell of each column header is added, 2) when each range of the body range is added, 3) When each header is changed from default to new value
 ' 2. If not:
 ' Two events are fired: 1) When each cell of each column header is added, 2) when each range of the body range is added
 If Not IsValidTable(Target) Then Exit Sub
 Set changedRange = Intersect(Target, SourceTable.Range)
 ' + 1 because we are processing each column header and (1) for the body ranges
 this.ColumnsAdded = SourceTable.ListColumns.Count - this.LastColumnCount + 1
 RecordChange changedRange
 ProcessRange
 this.ColumnsAdded = this.ColumnsAdded - 1
 Case Action = "columns added" And this.ColumnsAdded > 0
 If Not IsValidTable(Target) Then Exit Sub
 Set changedRange = Intersect(Target, SourceTable.Range)
 this.ColumnsAdded = this.ColumnsAdded - 1
 RecordChange changedRange
 ProcessRange
 If this.ColumnsAdded = 0 Then ResizeAndRecordPrevious Target
 Case Action = "rows added"
 If Not IsValidTable(Target) Then Exit Sub
 Set changedRange = Intersect(Target, SourceTable.Range)
 RecordChange changedRange
 ProcessRange
 ResizeAndRecordPrevious changedRange
 Case Action = "cells changed"
 If Not IsValidTable(Target) Then Exit Sub
 Set changedRange = Intersect(Target, SourceTable.Range)
 RecordChange changedRange
 ProcessRange
 ResizeAndRecordPrevious changedRange
 End Select
End Sub
Private Sub TableSheet_SelectionChange(ByVal Target As Range)
 If Not IsConnected(this.SourceTable) Then Exit Sub
 If Not TypeName(Target.ListObject) = "ListObject" Then Exit Sub
 If Not Target.ListObject.Name = SourceTable.Name Then Exit Sub
 RecordPreviousValues Target
End Sub
Private Function GetAction() As String
 Dim Action As String
 Select Case True
 Case SourceTable.ListColumns.Count > this.LastColumnCount
 Action = "columns added"
 Case SourceTable.ListRows.Count > this.LastRowCount
 Action = "rows added"
 Case SourceTable.ListColumns.Count < this.LastColumnCount
 Action = "columns deleted"
 Case SourceTable.ListRows.Count < this.LastRowCount
 Action = "rows deleted"
 Case SourceTable.DataBodyRange Is Nothing
 'TODO: implement case (MsgBox SourceTable.Name & " has no data") https://stackoverflow.com/a/15667123/1521579
 Case Else
 Action = "cells changed"
 End Select
 GetAction = Action
End Function
Private Function IsValidTable(ByVal Target As Range) As Boolean
 If Not TypeName(Target.ListObject) = "ListObject" Then Exit Function
 If Not Target.ListObject.Name = SourceTable.Name Then Exit Function
 If PreviousRangeAddress = vbNullString Then Exit Function
 IsValidTable = True
End Function

Class: SheetTable

'@Folder("TableManager")
'@PredeclaredId
Option Explicit
'@MemberAttribute VB_VarHelpID, -1
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 AddedRange As Range)
 Dim rangeColumn As Range
 For Each rangeColumn In AddedRange.Columns
 MsgBox "Added new table column in sheet column " & rangeColumn.Column & " and table column: " & GetCellColumn(myTable.SourceTable, rangeColumn) & ". Range address: " & rangeColumn.Address
 Next rangeColumn
End Sub
Private Sub MyTable_AddedNewRow(ByVal AddedRange As Range)
 Dim rangeRow As Range
 For Each rangeRow In AddedRange.Rows
 MsgBox "Added new table row in sheet row " & rangeRow.row & " and table row: " & GetCellRow(myTable.SourceTable, rangeRow) & ". Range address: " & rangeRow.Address
 Next rangeRow
End Sub
Private Sub MyTable_Changed(ByVal changedRange As Range)
 Dim cell As Range
 For Each cell In changedRange.Cells
 MsgBox "Changed " & cell.Address & " which belongs to the table: " & myTable.SourceTable.Name & _
 " row in table: " & GetCellRow(myTable.SourceTable, cell) & " column in table: " & GetCellColumn(myTable.SourceTable, cell) & _
 " previous value was: " & myTable.PreviousValues(GetCellRow(myTable.SourceTable, cell), GetCellColumn(myTable.SourceTable, cell)) & _
 " new value is: " & cell.Value
 Next cell
End Sub
Private Sub MyTable_DeletedColumn(ByVal deletedRange As Range)
 Dim rangeColumn As Range
 Dim cell As Range
 Dim tableRow As Long
 Dim tableColumn As Long
 For Each rangeColumn In deletedRange.Columns
 tableColumn = GetCellColumnInRange(rangeColumn, myTable.PreviousRange)
 For Each cell In rangeColumn.Cells
 tableRow = GetCellRowInRange(cell, myTable.PreviousRange)
 MsgBox "Deleted column " & tableColumn & " with value: " & myTable.PreviousValues(tableRow, tableColumn)
 Next cell
 Next rangeColumn
End Sub
Private Sub MyTable_DeletedRow(ByVal deletedRange As Range)
 Dim rangeRow As Range
 Dim cell As Range
 Dim tableRow As Long
 Dim tableColumn As Long
 For Each rangeRow In deletedRange.Rows
 tableRow = GetCellRowInRange(rangeRow, myTable.PreviousRange)
 For Each cell In rangeRow.Cells
 tableColumn = GetCellColumnInRange(cell, myTable.PreviousRange)
 MsgBox "Deleted row " & tableRow & " with value: " & myTable.PreviousValues(tableRow, tableColumn)
 Next cell
 Next rangeRow
End Sub
Private Sub MyTable_DeletedTable(ByVal tableName As String)
 MsgBox "Deleted table: " & tableName
End Sub

Class interface: ITables

'@Folder("TableManager")
'@Interface
Option Explicit
Public Property Get SheetTable(ByVal index As Variant) As ITable
End Property
Public Property Get Sheet() As Worksheet
End Property
Public Property Get Counter() As Long
End Property

Class interface: ITable

'@Folder("TableManager")
'@Interface
Option Explicit
Public Property Get SourceTable() As ListObject
End Property
Public Property Get Name() As String
End Property

Class: FastUnions

'@Folder("Framework.FastUnions")
Option Explicit
Private Unions As Collection
Public Sub Add(ByVal Obj As FastUnion)
 Unions.Add Obj
End Sub
'@DefaultMember
Public Property Get Item(ByVal index As Variant) As FastUnion
 Set Item = Unions.Item(index)
End Property
Public Property Get Count() As Long
 Count = Unions.Count
End Property
Private Sub Class_Initialize()
 Set Unions = New Collection
End Sub
Private Sub Class_Terminate()
 Set Unions = Nothing
End Sub
Public Function Items() As Collection
 Set Items = Unions
End Function

Class: FastUnion

'@Folder("Framework.FastUnions")
' https://codereview.stackexchange.com/questions/224874/brute-force-looping-formatting-or-create-union-range-format-which-is-effici/226296#226296
Option Explicit
Private Const DefaultCellCountGoal As Long = 250
Private RangeItems As New Collection
Private Item As Range
Private CellCountGoal As Long
Public Sub Add(ByRef NewRange As Range)
 If Item Is Nothing Then
 Set Item = NewRange
 Else
 Set Item = Union(Item, NewRange)
 End If
 If Item.CountLarge >= CellCountGoal Then Compact
End Sub
Private Sub Class_Initialize()
 CellCountGoal = DefaultCellCountGoal
End Sub
Public Function Items() As Collection
 Compact
 Set Items = RangeItems
End Function
Private Sub Compact()
 If Not Item Is Nothing Then
 RangeItems.Add Item
 Set Item = Nothing
 End If
End Sub

Module: RangeU

'@Folder("Framework")
Option Explicit
Public Function NotIntersect(ByVal FirstRange As Range, ByVal SecondRange As Range) As Range
 ' Credits: https://codereview.stackexchange.com/a/226296/197645
 ' Adapted to extract the non intersected cells between to ranges by Ricardo Diaz
 Dim evalCell As Range
 Dim parcialRange As Range
 Dim resultRange As Range
 Dim newUnion As FastUnion
 Dim newUnions As FastUnions
 If Intersect(FirstRange, SecondRange) Is Nothing Then
 Set NotIntersect = Nothing
 Exit Function
 End If
 Set newUnions = New FastUnions
 Set newUnion = New FastUnion
 ' Add cells in first range that don't intersect second range
 For Each evalCell In FirstRange
 If Intersect(evalCell, SecondRange) Is Nothing Then newUnion.Add evalCell
 Next evalCell
 If newUnion.Items.Count > 0 Then newUnions.Add newUnion
 ' Add cells in second range that don't intersect first range
 For Each evalCell In SecondRange
 If Intersect(evalCell, FirstRange) Is Nothing Then newUnion.Add evalCell
 Next evalCell
 If newUnion.Items.Count > 0 Then newUnions.Add newUnion
 ' Return cells in unions to range
 For Each newUnion In newUnions.Items
 For Each parcialRange In newUnion.Items
 If resultRange Is Nothing Then
 Set resultRange = parcialRange
 Else
 Set resultRange = Union(resultRange, parcialRange)
 End If
 Next parcialRange
 Next newUnion
 Set NotIntersect = resultRange
End Function

Module: ObjectU

'@Folder("Framework.Utilities")
Option Explicit
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
 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
 On Error GoTo 0
End Function

Module: ListObjectU

'@Folder("Framework")
Option Explicit
Public Function GetCellRow(ByVal myTable As ListObject, ByVal cell As Range) As Long
 ' Reference: https://stackoverflow.com/a/49638668/1521579
 GetCellRow = cell.row - myTable.HeaderRowRange.row + 1
End Function
Public Function GetCellColumn(ByVal myTable As ListObject, ByVal cell As Range) As Long
 GetCellColumn = cell.Column - myTable.HeaderRowRange.Column + 1
End Function
Public Function GetCellColumnInRange(ByVal cell As Range, ByVal TargetRange As Range) As Long
 ' Credits: https://stackoverflow.com/a/30846062/1521579
 ' Adapted by: Ricardo Diaz
 If Not Intersect(cell, TargetRange) Is Nothing Then
 GetCellColumnInRange = Range(cell(1), TargetRange(1)).Columns.Count
 End If
End Function
Public Function GetCellRowInRange(ByVal cell As Range, ByVal TargetRange As Range) As Long
 ' Credits: https://stackoverflow.com/a/30846062/1521579
 ' Adapted by: Ricardo Diaz
 If Not Intersect(cell, TargetRange) Is Nothing Then
 GetCellRowInRange = Range(cell(1), TargetRange(1)).Rows.Count
 End If
End Function

Module: TestModule

'@Folder("Test")
Option Explicit
Public Sub Testing()
 Dim TablesCol As ITables
 Dim STable As Variant
 Dim SampleSheet As Worksheet
 Set SampleSheet = ThisWorkbook.Worksheets("Sample")
 Set TablesCol = Tables.Create(SampleSheet)
 Debug.Print TablesCol.SheetTable("Table1").Name
 For Each STable In TablesCol
 Debug.Print STable.SourceTable.Name
 Next STable
End Sub

Code has annotations from Rubberduck add-in

asked Feb 3, 2020 at 1:07
\$\endgroup\$
2
  • 1
    \$\begingroup\$ I just wanted to say, that I really appreciate the time and effort that you put into your posts. I know how much it takes to write detailed posts like this, and It is not easy. Saying that, I haven't reviewed this thoroughly, but, one (albeit extremely nit picky) thing that stood out to me was the names of your events. Instead of naming something like OnAddedNewRow, I would say something like OnRowAdd. See <docs.microsoft.com/en-us/dotnet/standard/design-guidelines/…> \$\endgroup\$ Commented Feb 4, 2020 at 22:19
  • 2
    \$\begingroup\$ @rickmanalexander thank you. Will check the guidelines. I'm posting the code this way because I think that may help somebody else in the future. I've learned from other people that have done the same and the great answers from guys that take the time to review them. \$\endgroup\$ Commented Feb 4, 2020 at 22:24

0

Know someone who can answer? Share a link to this question via email, Twitter, or Facebook.

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.