If a cell contains the word "Completed", then return the date/time when it changed.

[awkwardjae]

Hi I have a excel form (mostly use it through sharepoint) where people submit a google form and request tasks for my team to complete. This google form autofills a row each time a request is submitted with different information not limited to submission date, ID, Name, Request etc. We have a status column (column S) in excel that contains one of "Not Started" default when request submitted, "In Progress" when someone enters their initial in "Prep" Column, "Not Tested" which we manually change if no do the request and "Completed" when we sign our initial in the "Done" Column AND "Prep" Column. All of this are automatically triggered (with exception of Not Tested). What I would like to include is a seperate column due to demand and audit reasons that says "Completed On" (column T) which essentially gets updated with the date and time that the Status column says "Completed".
Few things to note, would like this to apply automatically as requests are entered and status changes.
Currently we are on row 2751
If it cannot be applied retroactively that is fine, just for future requests
If possible if the status changes from Completed to another (due to someone accidentally signing) the completed on becomes blank.

I have tried:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim cell As Range

' See if any updates to specified range
Set rng = Intersect(Range("S2:S150000"), Target)

' Exit sub if no changes to watched range
If rng Is Nothing Then Exit Sub

' Loop through changed cells
Application.EnableEvents = False
For Each cell In rng
' See if cell is set to "Completed"
If cell.Value = "Completed" Then
' Add date stamp to column T of same row
cell.Offset(0, 1).Value = Now
End If
Next cell
Application.EnableEvents = True

End Sub

But does not seem to trigger the date showing.
Any help, advice, direction is appreciated. Thank you

 

[awkwardjae]

Then you are just checking to see if those columns are not blank?

That is essentially what it is, yes. Once all 4 columns are not blank, then the status changes to Completed.

 

[dreid1011]

I haven't tested this, but I believe it should work. Your original code is looping through the range, which would imply multiple cells could be changed at once. Is that true? Or are cells being changed one at a time? This alternate code works under the impression cells are being updated one at a time.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngI As Range, rngU As Range
Dim cell As Range

'Alternate code
'--------------------------------------------
Set rngU = Union(Range("M2:M150000"), Range("O2:O150000"), Range("P2:P150000"), Range("R2:R150000"))
Set rngI = Intersect(rngU, Target)
'--------------------------------------------

' See if any updates to specified range
'Set rngI = Intersect(Range("S2:S150000"), Target)

' Exit sub if no changes to watched range
If rngI Is Nothing Then Exit Sub


Application.EnableEvents = False
'Alternate code
'--------------------------------------------
If Range("S" & Target.Row) = "Completed" Then
    Range("T" & Target.Row) = Now
Else
    Range("T" & Target.Row) = ""
End If
'--------------------------------------------

' Loop through changed cells
'For Each cell In rngI
'    ' See if cell is set to "Completed"
'    If cell.Value = "Completed" Then
'        ' Add date stamp to column T of same row
'        cell.Offset(0, 1).Value = Now
'    Else
'        cell.Offset(0, 1).Value = ""
'    End If
'Next cell
Application.EnableEvents = True

End Sub

 

[awkwardjae]

I haven't tested this, but I believe it should work. Your original code is looping through the range, which would imply multiple cells could be changed at once. Is that true? Or are cells being changed one at a time? This alternate code works under the impression cells are being updated one at a time.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngI As Range, rngU As Range
Dim cell As Range

'Alternate code
'--------------------------------------------
Set rngU = Union(Range("M2:M150000"), Range("O2:O150000"), Range("P2:P150000"), Range("R2:R150000"))
Set rngI = Intersect(rngU, Target)
'--------------------------------------------

' See if any updates to specified range
'Set rngI = Intersect(Range("S2:S150000"), Target)

' Exit sub if no changes to watched range
If rngI Is Nothing Then Exit Sub


Application.EnableEvents = False
'Alternate code
'--------------------------------------------
If Range("S" & Target.Row) = "Completed" Then
    Range("T" & Target.Row) = Now
Else
    Range("T" & Target.Row) = ""
End If
'--------------------------------------------

' Loop through changed cells
'For Each cell In rngI
'    ' See if cell is set to "Completed"
'    If cell.Value = "Completed" Then
'        ' Add date stamp to column T of same row
'        cell.Offset(0, 1).Value = Now
'    Else
'        cell.Offset(0, 1).Value = ""
'    End If
'Next cell
Application.EnableEvents = True

End Sub

Will test code and let you know on Monday. Thank you very much!
The only cells that change at once are A#:N# (because it autopopulates at once from a form), which aren't relevant to the code. But cells M#,O#,P#,R# are changed one at a time

 

[awkwardjae]

I haven't tested this, but I believe it should work. Your original code is looping through the range, which would imply multiple cells could be changed at once. Is that true? Or are cells being changed one at a time? This alternate code works under the impression cells are being updated one at a time.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngI As Range, rngU As Range
Dim cell As Range

'Alternate code
'--------------------------------------------
Set rngU = Union(Range("M2:M150000"), Range("O2:O150000"), Range("P2:P150000"), Range("R2:R150000"))
Set rngI = Intersect(rngU, Target)
'--------------------------------------------

' See if any updates to specified range
'Set rngI = Intersect(Range("S2:S150000"), Target)

' Exit sub if no changes to watched range
If rngI Is Nothing Then Exit Sub


Application.EnableEvents = False
'Alternate code
'--------------------------------------------
If Range("S" & Target.Row) = "Completed" Then
    Range("T" & Target.Row) = Now
Else
    Range("T" & Target.Row) = ""
End If
'--------------------------------------------

' Loop through changed cells
'For Each cell In rngI
'    ' See if cell is set to "Completed"
'    If cell.Value = "Completed" Then
'        ' Add date stamp to column T of same row
'        cell.Offset(0, 1).Value = Now
'    Else
'        cell.Offset(0, 1).Value = ""
'    End If
'Next cell
Application.EnableEvents = True

End Sub

Code seems to be working as intended! Thank you so much, you have been a phenomenal help!

 

[dreid1011]

Code seems to be working as intended! Thank you so much, you have been a phenomenal help!

You're welcome and happy to help. Don't forget to mark the solution if you could please.