CODEWITHSUNDEEP
excelvbadatetimeexcel-formula
HumMing birD
HumMing birD

Reputation: 19

Copy just the values of date to another cell

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

enter image description here

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(),"")

Upvotes: 0

Views: 919

Answers (2)

VBasic2008
VBasic2008

Reputation: 54807

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

Upvotes: 1

Spinner
Spinner

Reputation: 1088

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.

Upvotes: 2

Related Questions