Adapting a VBA Subroutine from referencing a single cell to referencing a table column

[DavidRains]

I have a column (named "Complete") in an Excel Table that is populated with a formula. I am trying to implement code to detect if a formula value in the column has changed, and if so, to identify the address that changed so the code can perform an action.

From another thread in this forum I found code that identifies changes in a singe cell, and it works well to indicate that the formula result in that cell changed:
Private Sub Worksheet_Calculate()
Static oldval
If Range("C1").Value <> oldval Then
oldval = Range("C1").Value
'
'rest of your code here
'
End If
End SubBut I am having difficulty adapting this code to check for changes in the entire Table column instead of in a single cell, and to then identify which cell has changed.

Any help would be greatly appreciated.

 

[dmt32]

Hi,
if you want to record all cell changes then one option maybe to store changed addresses in an array

Not fully tested but see if this update to your code helps

Private Sub Worksheet_Calculate()
    Dim Cell As Object
    Dim tbl As ListObject
    Dim arr() As Variant, ChangedAddress As Variant
    Dim i As Integer


    Set tbl = ActiveSheet.ListObjects("Table1")
    
    With tbl.ListColumns("Complete").DataBodyRange
'size array
    ReDim arr(1 To .Cells.Count)
        For Each Cell In .Cells
            If Cell.ID <> Cell.Value Then
            i = i + 1
            arr(i) = Cell.Address
            Cell.ID = Cell.Value
            End If
        Next Cell
    End With
'no changes exit sub
    If i = 0 Then Exit Sub
'resize array
    ReDim Preserve arr(1 To i)
    
'use array in your code as required
'example
    For Each ChangedAddress In arr
        MsgBox ChangedAddress
    Next ChangedAddress
End Sub

Change Table Name shown in RED as required

Hope Helpful

Dave

 

[John_w]

Same approach, with the "Complete" column values stored in an array which is initialised with the current values in the Workbook_Open event. Assumes the table in question is the first table in the Sheet1 code module sheet, hence the Set table = Sheet1.ListObjects(1).

ThisWorkbook module:

Option Explicit

Private Sub Workbook_Open()

    Dim table As ListObject
    Dim r As Long
    
    Set table = Sheet1.ListObjects(1)
    
    With table.ListColumns("Complete").DataBodyRange
        ReDim tableColumnValues(1 To .Rows.Count)
        For r = 1 To .Rows.Count
            tableColumnValues(r) = .Rows(r).Value
        Next
    End With

End Sub

Sheet1 module:

Private Sub Worksheet_Calculate()

    Dim table As ListObject
    Dim r As Long
    
    Set table = Me.ListObjects(1)
    
    With table.ListColumns("Complete").DataBodyRange
        For r = 1 To .Rows.Count
            If tableColumnValues(r) <> .Rows(r).Value Then
                MsgBox "Complete cell in data row " & r & " has changed - address = " & .Rows(r).Address
            End If
        Next
    End With

End Sub

Module1 (a standard module):

Option Explicit

Public tableColumnValues() As Variant

Save, close and reopen the macro workbook to activate the code.

 

[DavidRains]

Dave,

Thanks. I get a Run Time Error '1004': Application-defined or object-defined error, on the line: Cell.ID = Cell.Value when any value in the worksheet changes.

By the way, the way the formula only references values from it's same row, so only one value in the target column would change at a time upon recalculation.

Hi,
if you want to record all cell changes then one option maybe to store changed addresses in an array

Not fully tested but see if this update to your code helps

Private Sub Worksheet_Calculate()
    Dim Cell As Object
    Dim tbl As ListObject
    Dim arr() As Variant, ChangedAddress As Variant
    Dim i As Integer


    Set tbl = ActiveSheet.ListObjects("Table1")
    
    With tbl.ListColumns("Complete").DataBodyRange
'size array
    ReDim arr(1 To .Cells.Count)
        For Each Cell In .Cells
            If Cell.ID <> Cell.Value Then
            i = i + 1
            arr(i) = Cell.Address
            Cell.ID = Cell.Value
            End If
        Next Cell
    End With
'no changes exit sub
    If i = 0 Then Exit Sub
'resize array
    ReDim Preserve arr(1 To i)
    
'use array in your code as required
'example
    For Each ChangedAddress In arr
        MsgBox ChangedAddress
    Next ChangedAddress
End Sub

Change Table Name shown in RED as required

Hope Helpful

Dave

 

[John_w]

I forgot to update the current value in the array when the cell changes. The Worksheet_Calculate in the Sheet1 module should be:

Private Sub Worksheet_Calculate()

    Dim table As ListObject
    Dim r As Long
    
    Set table = Me.ListObjects(1)
    
    With table.ListColumns("Complete").DataBodyRange
        For r = 1 To .Rows.Count
            If tableColumnValues(r) <> .Rows(r).Value Then
                MsgBox "Complete cell in data row " & r & " has changed - address = " & .Rows(r).Address & vbCrLf & _
                    "Old value = " & tableColumnValues(r) & ", new value = " & .Rows(r).Value
                tableColumnValues(r) = .Rows(r).Value
            End If
        Next
    End With

End Sub

This also displays the old and new values of the changed cell(s).

 

[DavidRains]

Thanks again. Does tableColumnValues need to be defined and initialized? I get Compile error: Sub or Function not defined when the code runs.

I forgot to update the current value in the array when the cell changes. The Worksheet_Calculate in the Sheet1 module should be:

Private Sub Worksheet_Calculate()

    Dim table As ListObject
    Dim r As Long
    
    Set table = Me.ListObjects(1)
    
    With table.ListColumns("Complete").DataBodyRange
        For r = 1 To .Rows.Count
            If tableColumnValues(r) <> .Rows(r).Value Then
                MsgBox "Complete cell in data row " & r & " has changed - address = " & .Rows(r).Address & vbCrLf & _
                    "Old value = " & tableColumnValues(r) & ", new value = " & .Rows(r).Value
                tableColumnValues(r) = .Rows(r).Value
            End If
        Next
    End With

End Sub

This also displays the old and new values of the changed cell(s).

 

[John_w]

Thanks again. Does tableColumnValues need to be defined and initialized? I get Compile error: Sub or Function not defined when the code runs.

Yes to both questions.

tableColumnValues is defined (as a global variable, so it can be 'seen' by all the code) in Module1. It is initialised in the Workbook_Open procedure in the ThisWorkbook module.

https://www.contextures.com/xlvba01.html shows the 3 places where the 3 different parts of my code should be placed - Workbook module (ThisWorkbook), Sheet module (Sheet1) and Regular module (Module1).

 

[DavidRains]

My mistake. This works very well. Thanks for the assistance.

Yes to both questions.

tableColumnValues is defined (as a global variable, so it can be 'seen' by all the code) in Module1. It is initialised in the Workbook_Open procedure in the ThisWorkbook module.

https://www.contextures.com/xlvba01.html shows the 3 places where the 3 different parts of my code should be placed - Workbook module (ThisWorkbook), Sheet module (Sheet1) and Regular module (Module1).

 

[John_w]

Glad you got it working!