Timestamp code needs tweak to only execute if cell returns "TRUE"

[mhwolog]

Hi all,
I have found this code for a timestamp, which I have pasted in VBA under the applicable worksheet (which I believe is the correct spot?).

Column C has an IF formula that returns a TRUE or FALSE. The answer always starts out FALSE.

The code is supposed to look for changes to cells in column C (i.e. switch from FALSE to TRUE), and if column D is blank, then add a timestamp in D (so that only the time of the "first" change to column C is timestamped).

The code satisfies the "first" timestamp only, but it seems to put in this timestamp every time the IF formula calculates (even if the solution recalculates and returns FALSE) - but I only want the timestamp to occur if the IF formula returns TRUE (I want the timestamp to remain if there is a change from FALSE -> TRUE -> FALSE)

Can you please help tweak the code? Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20180830
Dim xCellColumn As Integer
Dim xTimeColumn As Integer
Dim xRow, xCol As Integer
Dim xDPRg, xRg As Range
xCellColumn = 3
xTimeColumn = 4
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
    If xCol = xCellColumn Then
        Cells(xRow, xTimeColumn) = Now()
       
    Else
        On Error Resume Next
        Set xDPRg = Target.Dependents
        For Each xRg In xDPRg
            If xRg.Column = xCellColumn Then
                If Cells(xRg.Row, xTimeColumn) = "" Then
                     Cells(xRg.Row, xTimeColumn) = Now()
                End If
            End If
        Next
    End If
End If
End Sub

 

[John_w]

The Now() lines are triggering the event handler. Try adding Application.EnableEvents = False/True within the start and end of the outer If block to prevent this.

 

[mhwolog]

Hi John,
I tried this code, and several other variations, but it still has the same problem. Any other thoughts? Thanks,

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20180830
Dim xCellColumn As Integer
Dim xTimeColumn As Integer
Dim xRow, xCol As Integer
Dim xDPRg, xRg As Range
xCellColumn = 3
xTimeColumn = 4
xRow = Target.Row
xCol = Target.Column




If Target.Text <> "" Then
  Application.EnableEvents = False
 
    If xCol = xCellColumn Then
        Cells(xRow, xTimeColumn) = Now()
       
    Else
        On Error Resume Next
        Set xDPRg = Target.Dependents
        For Each xRg In xDPRg
            If xRg.Column = xCellColumn Then
                If Cells(xRg.Row, xTimeColumn) = "" Then
                     Cells(xRg.Row, xTimeColumn) = Now()
                End If
            End If
        Next
    End If
 Application.EnableEvents = True
   
End If


End Sub

 

[John_w]

You've placed the EnableEvents correctly.

Slight variation of your code - does this work?

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim cell As Range
    Dim dependentsRange As Range
            
    If Target.Text <> "" Then
    
        Application.EnableEvents = False
        
        If Target.Column = 3 Then
            Cells(Target.Row, 4) = Now
        Else
            Set dependentsRange = Nothing
            On Error Resume Next
            Set dependentsRange = Target.Dependents
            On Error GoTo 0
            If Not dependentsRange Is Nothing Then
                For Each cell In dependentsRange
                    If cell.Column = 3 Then
                        If IsEmpty(Cells(cell.Row, 4).Value) Then
                             Cells(cell.Row, 4) = Now
                        End If
                    End If
                Next
            End If
        End If
        
        Application.EnableEvents = True

    End If

End Sub

 

[mhwolog]

Hi John,
No sorry it still doesn't seem to work; I'm using a UDF in column C which returns TRUE or FALSE, but I don't think this is the issue.

Even if I just put =IF(B4>3, "TRUE", "FALSE") in C4
The timestamp occurs in D4 if B2 changes from 1 to 2. It should only occur if B2 changes from 1 to 4. ???

I'm a bit stumped.

 

[John_w]

I think it also needs to check whether the column C cell value is True:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim cell As Range
    Dim dependentsRange As Range
            
    If Target.Text <> "" Then
    
        Application.EnableEvents = False
        
        If Target.Column = 3[B] [COLOR=#ff0000]And Target.Value = True[/COLOR][/B] Then
            Cells(Target.Row, 4) = Now
        Else
            Set dependentsRange = Nothing
            On Error Resume Next
            Set dependentsRange = Target.Dependents
            On Error GoTo 0
            If Not dependentsRange Is Nothing Then
                For Each cell In dependentsRange
                    If cell.Column = 3 [COLOR=#ff0000][B]And cell.Value = True[/B][/COLOR] Then
                        If IsEmpty(Cells(cell.Row, 4).Value) Then
                             Cells(cell.Row, 4) = Now
                        End If
                    End If
                Next
            End If
        End If
        
        Application.EnableEvents = True

    End If

End Sub

 

[mhwolog]

Thanks John,
That works now for a normal IF statement; but seems to interfer with my UDF, as now the UDF returns zero instead of false at the beginning - and then later even if it starts returning TRUE/FALSE, then the timestamp stops working? Sorry I'm reasonably new to VBA. I tried adding in application.enableevents = true within the UDF, and tried incorporating the timestamp code into the UDF, but this didn't work for me.... I may be putting it in the wrong spot.

Function Alarm(cell, Condition)


Dim strAlarmHTKpath As String, varProc As Variant


On Error GoTo ErrHandler
    If Evaluate(cell.Value & Condition) Then
        If Worksheets("Sheet1").Range("A1").Text <> "" Then 'Alarm is disabled
         'strAlarmHTKpath = "C:\users\Tim\dropbox\alarm.exe" 'Alarm will not sound
        Else
         strAlarmHTKpath = "C:\users\Tim\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
         varProc = Shell(strAlarmHTKpath, 1)
        End If
      
         
         Alarm = True
        
        Exit Function
    End If
ErrHandler:
    Alarm = False
End Function

 

[John_w]

Without seeing exactly how the formula is calling your UDF, I can't reproduce the issue you describe, however the following code works for me. The formula in C4 is =Alarm(B4,">="&ROW()), dragged down a few rows, so the formula result is TRUE if B4 is >= 4 (i.e. the row number), otherwise FALSE.

I don't have your alarm.exe so my Alarm UDF uses a Windows sound.

Worksheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim cell As Range
    Dim dependentsRange As Range
        
    Debug.Print "---- Worksheet_Change ----" & vbNewLine & "Target: " & Target.Address
    
    Application.EnableEvents = False
            
    If Not Intersect(Target, Columns("C")) Is Nothing Then
        
        Debug.Print "Column C changed"
        For Each cell In Target
            Debug.Print cell.Address
            If cell.Value = True And IsEmpty(Cells(cell.Row, 4).Value) Then
                Cells(cell.Row, 4) = Now
            End If
        Next
        
    Else
    
        Set dependentsRange = Nothing
        On Error Resume Next
        Set dependentsRange = Target.Dependents
        On Error GoTo 0
        If Not dependentsRange Is Nothing Then
            Debug.Print "Dependents of Column C changed"
            For Each cell In dependentsRange
                Debug.Print cell.Address
                If cell.Column = 3 And cell.Value = True Then
                    If IsEmpty(Cells(cell.Row, 4).Value) Then
                         Cells(cell.Row, 4) = Now
                    End If
                End If
            Next
        End If
    
    End If
    
    Application.EnableEvents = True

End Sub

Standard module (e.g. Module1):

#If VBA7 Then
Private Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
    (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
Private Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
    (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Public Function Alarm(cell, Condition) As Boolean

    Dim strAlarmHTKpath As String, varProc As Variant
        
    Debug.Print "Alarm: " & cell.Address
    
    On Error GoTo ErrHandler
    
    If Evaluate(cell.Value & Condition) Then
        If Worksheets("Sheet1").Range("A1").Text <> "" Then 'Alarm is disabled
            'strAlarmHTKpath = "C:\users\Tim\dropbox\alarm.exe" 'Alarm will not sound
        Else
            'strAlarmHTKpath = "C:\users\Tim\dropbox\alarm.exe" 'Must be an exe file, .ahk won't work; Alarm will sound
            'varProc = Shell(strAlarmHTKpath, 1)
            sndPlaySound32 "C:\Windows\Media\tada.wav", &H1
        End If
        Alarm = True
        Exit Function
    End If
    
ErrHandler:
        Alarm = False
        
End Function

 

[mhwolog]

Thank you so much that works for me also. I'm not sure what the difference was - maybe just that your Function was Public?