CODEWITHSUNDEEP
excelvbaautomationtimestamp
Binne
Binne

Reputation: 19

Auto Update Timestamp in Excel

I'm currently working on a sheet that has to automatically insert todays date in a cell, if another cell is = "Yes"

I currently have this line of code (that I found online):

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim cell As Range
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
        Application.EnableEvents = False
        For Each cell In Target
            cell.Offset(0, 4).Value = Now
            cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
        Next cell
    End If
    Application.EnableEvents = True
End Sub

The problem is that the updated cell in row K is being updated every time the cell is changed, and it should only be updated when the cell in row G = "Yes"

I appreciate the help :)

Upvotes: 0

Views: 369

Answers (2)

FunThomas
FunThomas

Reputation: 29592

Your basic problem is solved easily - just add an If to check the content of the cell:

    For Each cell In Target
        If UCase(cell.Value2) = "YES" Then
            cell.Offset(0, 4).Value = Now
            cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
        Next cell
   Next cell

However, your check for column 'G' is flawed. Target contains all cells that are currently modified. If the user enter something into a cell, Target will contain exactly that cell. If, however, data is for example pasted into that sheet, Target will contain all cells where data is pasted into.

Now, Intersect checks if two ranges have common cells. Your statement If Not Intersect(Target, Range("G:G")) Is Nothing will check if any of the modified cells is in column G and if yes, it will write the date into the cell that is 4 columns to the right. In the case the user enter something into a cell of column G, that's okay. But if he pastes something into, let's say, cells of columns F,G,H, the code will run for all three cells. So you should check each cell individually.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo change_exit    ' Ensure that events are re-enabled in case of error
    Application.EnableEvents = False
    Dim cell As Range
    For Each cell In Intersect(Target, Range("G:G"))
        If UCase(cell.Value2) = "YES" Then
            cell.Offset(0, 4).Value = Now
            cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
        end if
    Next cell
change_exit:
    Application.EnableEvents = True
End Sub

Update: Changed the logic by just looping over the cells of target that intersect with column G - thanks to BigBen for the hint.

Upvotes: 1

Gary's Student
Gary's Student

Reputation: 96781

Consider:

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim cell As Range
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
        Application.EnableEvents = False
        For Each cell In Target
            If cell.Value = "Yes" Then
                cell.Offset(0, 4).Value = Now
                cell.Offset(0, 4).NumberFormat = "dd/mm/yyyy"
            End If
        Next cell
    End If
    Application.EnableEvents = True
End Sub

We test the value of each entry!

Upvotes: 0

Related Questions