My question is about a follow-up on a discussion between callumda and andy here:

Question

I have 7 tables in a worksheet. A timestamp is needed on each table based on formula change of each cells in a range. I had applied this code here: https://chat.stackoverflow.com/rooms/139804/discussion-between-callumda-and-andy

Unfortunately the timestamp works in the first table only, it inputs the timestamp in the other tables but proptly reiterates many times, freezes & closes the excel workbook. I have used this code on first 3 tables with success on the first table.

What could be the cause of the reiteration & sudden closure of the entire workbook by excel & how can I adjust the code a little since I have verified it works on the first table without freezing the open workbook

excel VBA on Microsoft Office 2016

In ThisWorkbook:

In Private Sub Workbook_Open() D

im r As Range
Set PrevVal = New Dictionary
 For Each r In Worksheets("DFC MM Plays").Range("A7:A16")
  PrevVal.Add Item:=r.Value, Key:=r.Address
 Next r
Set PrevVal2 = New Dictionary
 For Each r In Worksheets("TREAMP").Range("A12:A27")
  PrevVal2.Add Item:=r.Value, Key:=r.Address
 Next r
Set PrevVal3 = New Dictionary
 For Each r In Worksheets("Nkd Trad Plays").Range("A10:A16")
  PrevVal3.Add Item:=r.Value, Key:=r.Address
 Next r
End Sub

In Global Module 12:

Public PrevVal As Dictionary Public PrevVal2 As Dictionary Public PrevVal3 As Dictionary

In each individual worksheets in Excel Objects:

DFC MM Plays Worksheet:

Private Sub Worksheet_Calculate()
Dim v As Variant
For Each v In PrevVal.Keys()
If Range(v).Value <> PrevVal(v) Then
  Range(v).Offset(0, 2).Value = Format(Now, "mm/d/yyyy hh:mm:ss")
  PrevVal(v) = Range(v).Value
End If
Next v
End Sub

In TREAMP Worksheet

 Private Sub Worksheet_Calculate()
    Dim v As Variant
    For Each v In PrevVal2.Keys()
    If Range(v).Value <> PrevVal2(v) Then
      Range(v).Offset(0, 5).Value = Format(Now, "mm/d/yyyy hh:mm:ss")
      PrevVal2(v) = Range(v).Value
    End If
    Next v
    End Sub

In Nkd Trad Plays Worksheet Private Sub Worksheet_Calculate()

Dim v As Variant
 For Each v In PrevVal3.Keys()
  If Range(v).Value <> PrevVal3(v) Then
  Range(v).Offset(0, 2).Value = Format(Now, "mm/d/yyyy hh:mm:ss")
  PrevVal3(v) = Range(v).Value
  End If
 Next v
End Sub

Sudden freeze and closure of entire excel workbook

TinMan TinMan · Accepted Answer · 2019-08-08T09:56:23

I assume that Range(v).Offset(0, 2).Value = Format(Now, "mm/d/yyyy hh:mm:ss") is causing the worksheet to recalculate.

Updating the Dictionary value before assigning the timestamp will prevent an infinite loop.

PrevVal3(v) = Range(v).Value
Range(v).Offset(0, 2).Value = Format(Now, "mm/d/yyyy hh:mm:ss")

I would disable events while updating the timestamps to be on the safe side.

Application.EnableEvents = False

For Each v In PrevVal2.Keys()
    If Range(v).Value <> PrevVal2(v) Then
      Range(v).Offset(0, 5).Value = Format(Now, "mm/d/yyyy hh:mm:ss")
      PrevVal2(v) = Range(v).Value
    End If
Next v

Application.EnableEvents = True

Here is how I would write the project. Notice that I uses a dictionary of dictionaries to store the keys and values. I also store the range directly in the dictionary as a key. It is better to store the numeric value of Now() then it is to store its formatted value.

ThisWorkbook:Module

Option Explicit

Private TimeStampRangeMap As New Dictionary

Private Sub Workbook_Open()
    AddTimeStampRange Worksheets("DFC MM Plays").Range("A7:A16")
    AddTimeStampRange Worksheets("TREAMP").Range("A12:A27")
    AddTimeStampRange Worksheets("Nkd Trad Plays").Range("A10:A16")
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Dim Key
    Dim Map As Dictionary
    Dim ColumnIndex As Long

    If TimeStampRangeMap.Exists(Sh) Then
        ColumnIndex = getColumnIndex(Sh)

        Application.EnableEvents = False
        Set Map = TimeStampRangeMap(Sh)
        For Each Key In Map
            If Key.Value <> Map(Key) Then
                Key.Offset(0, ColumnIndex).Value = Now
                Map(Key) = Key.Value
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub

Private Function getColumnIndex(ByVal Sh As Object) As Long
    Dim ColumnIndex As Long

    Select Case Sh.Name
    Case "DFC MM Plays", "Nkd Trad Plays"
        ColumnIndex = 2
    Case "TREAMP"
        ColumnIndex = 5
    End Select

    getColumnIndex = ColumnIndex
End Function

Private Sub AddTimeStampRange(ByRef Target As Range)
    If Not TimeStampRangeMap.Exists(Target.Parent) Then TimeStampRangeMap.Add Target.Parent, New Dictionary

    Dim r As Range, Map As Dictionary
    Set Map = TimeStampRangeMap(Target.Parent)

    For Each r In Target
        Map.Add Item:=r.Value, Key:=r
        r.Interior.Color = vbYellow
    Next r
End Sub

My question is about a follow-up on a discussion between callumda and andy here:

1 Answers

ThisWorkbook:Module