I am trying to copy the current date and time based on below

if a cell in column E changes to Contacted, then need add the timestamp but it should not change when the next time i open the excel

I am editing the column E by manually, see below picture

I know that to catch the date I use NOW() but my issue is the next day when I open the excel sheet it's changing the date to that date. I don't need that.

I want the date to occur only one time and don't change it. How can I do this? Any answers are highly appreciated

I am trying the below code but it does not work

=IF((E2)="Contacted",NOW(),"")

CodePudding user response：

Further to my comments above: What I'm suggesting is to drop the formula entirely.

Instead, write a vba Worksheet_Change event handler.
o Example given in vba help shows you how do that.
o This sub goes into the worksheet's code module.

In the event handler test for:

1. Changed cell being of interest (i.e. in Columns("E") )
2. Changed cell value is of interest (i.e. = "Contacted")
3. Target cell (i.e. where the timestamp goes) being empty (i.e. = "")

If conditions met: Write timestamp value to the Target cell (i.e. = Now())

Note: You'll likely want to also handle operator errors (e.g. change to Contacted, and then changed to something else).
In which case, you'll want to clear the relevant timestamp cell.

CodePudding user response：

Add Timestamp on Drop-Down Value

• Copy the following into the sheet module e.g. Sheet1 (not ThisWorkbook and not Module1) of the mentioned worksheet.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error GoTo ClearError

    Const sCriteria As String = "Contacted" ' Source Criteria
    Const sFirst As String = "E2" ' where the criteria will be searched for
    Const dCol As String = "F" ' where the time stamp will be added
    
    Dim scrg As Range ' Source Column Range
    With Me.Range(sFirst)
        Set scrg = .Resize(Me.Rows.Count - .Row   1)
    End With
    Dim srg As Range: Set srg = Intersect(scrg, Target)

    If srg Is Nothing Then Exit Sub ' no change in the source column range
        
    Dim sCell As Range ' Source Cell
    Dim dwrg As Range ' Destination Write Range
    Dim dCell As Range ' Destination Cell
    
    ' Combine the cells to be written to into a range ('dwrg').
    For Each sCell In srg.Cells
        Set dCell = sCell.EntireRow.Columns(dCol)
        If IsEmpty(dCell) Then ' destination cell is empty
            If CStr(sCell.Value) = sCriteria Then ' is 'sCriteria'
                If dwrg Is Nothing Then ' combine first cell
                    Set dwrg = dCell
                Else ' combine any but the first cell
                    Set dwrg = Union(dwrg, dCell)
                End If
            'Else ' is not 'sCriteria'
            End If
        'Else ' destination cell is not empty
        End If
    Next sCell
    
    ' Disable events to not retrigger this or any other while writing
    ' the timestamp(s).
    Application.EnableEvents = False
    
    ' Write the timestamp in one go.
    If Not dwrg Is Nothing Then ' at least one cell combined
        dwrg.Value = Now
    'Else ' no cells combined
    End If

SafeExit:
    If Not Application.EnableEvents Then ' events disabled
        Application.EnableEvents = True
    'Else ' events enabled
    End If
    
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub