1
\$\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

\$\endgroup\$
2
  • \$\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

Browse other questions tagged or ask your own question.