date & time stamp

[Trevor3007]

good evening,

i have to time\date stamp every entry placed in a worksheet. Is there a way to use =now() so when a new entry is done , any previous wont update to the new time\date?




MTIA
Trevor 3007

 

[Trevor3007]

Go to the sheet that you want to apply this to, right-click on the sheet tab name at the bottom of the screen, select "View Code", and paste this code in the resulting VB Editor window.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    
'   Capture cells updated in our designated range
    Set rng = Intersect(Target, Range("X2:X200"))
    
'   Exit if no cells in range being updated
    If rng Is Nothing Then Exit Sub
    
'   Loop through cells just updated in our designated range
    For Each cell In rng
'       If something in the cell, add date stamp to column Y
        If cell <> "" Then
            cell.Offset(0, 1) = Now()
'       Clear column Y if column X is blank
        Else
            cell.Offset(0, 1).ClearContents
        End If
    Next cell
    
End Sub

I believe this should automatically do what you want.

wow Joe4 thats fantastic. & works ace too....

However, it now transpires that the date stamp should only 'stamp when the word "Task Completed" is in the range (x2:x200) , I tried (in vain) to sort, but I just messed it up.
Could you kindly amended for me ?

Many many thanks Joe4

 

[Joe4]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    
'   Capture cells updated in our designated range
    Set rng = Intersect(Target, Range("X2:X200"))
    
'   Exit if no cells in range being updated
    If rng Is Nothing Then Exit Sub
    
'   Loop through cells just updated in our designated range
    For Each cell In rng
'       If cell is "Task Completed", add date stamp to column Y
        If cell = "Task Completed" Then cell.Offset(0, 1) = Now()
    Next cell
    
End Sub

Note that this will not remove the timestamp if the cell is blanked out.
If you want that to happen too, let me know.

 

[Trevor3007]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    
'   Capture cells updated in our designated range
    Set rng = Intersect(Target, Range("X2:X200"))
    
'   Exit if no cells in range being updated
    If rng Is Nothing Then Exit Sub
    
'   Loop through cells just updated in our designated range
    For Each cell In rng
'       If cell is "Task Completed", add date stamp to column Y
        If cell = "Task Completed" Then cell.Offset(0, 1) = Now()
    Next cell
    
End Sub

Note that this will not remove the timestamp if the cell is blanked out.
If you want that to happen too, let me know.

thanks for your quick reply Joe4

Yes I would prefer it to work if the cell is clanked out please, And rather than use a word held in the VB, can on be based on a cell ref IE JB7

MTIA
Trevor3007

 

[Joe4]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim val As String
    
'   Capture value in cell JB7
    val = Range("JB7")
    
'   Capture cells updated in our designated range
    Set rng = Intersect(Target, Range("X2:X200"))
    
'   Exit if no cells in range being updated
    If rng Is Nothing Then Exit Sub
    
'   Loop through cells just updated in our designated range
    For Each cell In rng
        Select Case cell.Value
'           If value in cell matches val variable, add timestamp to column Y
            Case val
                cell.Offset(0, 1) = Now()
'           If value is blank, clear column Y
            Case ""
                cell.Offset(0, 1).ClearContents
        End Select
    Next cell
    
End Sub

 

[Trevor3007]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim val As String
    
'   Capture value in cell JB7
    val = Range("JB7")
    
'   Capture cells updated in our designated range
    Set rng = Intersect(Target, Range("X2:X200"))
    
'   Exit if no cells in range being updated
    If rng Is Nothing Then Exit Sub
    
'   Loop through cells just updated in our designated range
    For Each cell In rng
        Select Case cell.Value
'           If value in cell matches val variable, add timestamp to column Y
            Case val
                cell.Offset(0, 1) = Now()
'           If value is blank, clear column Y
            Case ""
                cell.Offset(0, 1).ClearContents
        End Select
    Next cell
    
End Sub

you sir, are a genius.

I could go on & on with various ' can it do this & can it do that. but you have done everything i asked & i shall always marvel at your work.

hope ( & you certainly deserve) a wonderful xmas and a very £££ 2019....ho, ho hoooo

Kindest regards
Trevor3007

 

[Trevor3007]

Go to the sheet that you want to apply this to, right-click on the sheet tab name at the bottom of the screen, select "View Code", and paste this code in the resulting VB Editor window.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
   
'   Capture cells updated in our designated range
    Set rng = Intersect(Target, Range("X2:X200"))
   
'   Exit if no cells in range being updated
    If rng Is Nothing Then Exit Sub
   
'   Loop through cells just updated in our designated range
    For Each cell In rng
'       If something in the cell, add date stamp to column Y
        If cell <> "" Then
            cell.Offset(0, 1) = Now()
'       Clear column Y if column X is blank
        Else
            cell.Offset(0, 1).ClearContents
        End If
    Next cell
   
End Sub

I believe this should automatically do what you want.

Hi Joe4,

Please except my sincere apologies for not reply sooner & thank you for your help.

I think I have lost the plot a tad & would appreciate your help again . I think my reach out to Mr Excel was to to after entering tecx in to any cell in the range c2:-i85 & the date would auto fill in a2:a85. Ii also wanted the date to remain the same date and not change the next day as would happen using =now().
I am sure that your code does this, but ( and again my apologies) it its not working for me.

many thanks in advance

 

[Joe4]

You just need to change the range references, i.e.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
   
'   Capture cells updated in our designated range
    Set rng = Intersect(Target, Range("C2:I85"))
   
'   Exit if no cells in range being updated
    If rng Is Nothing Then Exit Sub
   
'   Loop through cells just updated in our designated range
    For Each cell In rng
'       If something in the cell, add date stamp to column A
        If cell <> "" Then
            Cells(cell.Row, "A") = Now()
'       Clear column Y if column X is blank
        Else
            Cells(cell.Row, "A").ClearContents
        End If
    Next cell
   
End Sub

Note: Don't be fooled by the ="Now()" formula. That is a VBA formula, not a spreadsheet formula.
And we are NOT putting a formula on the sheet, we are pasting that value on the sheet at the time it is being run.
So a hard-coded value that will not change (unless another value chnages) is being added.

 

[Trevor3007]

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim cell As Range ' Capture cells updated in our designated range Set rng = Intersect(Target, Range("C2:I85")) ' Exit if no cells in range being updated If rng Is Nothing Then Exit Sub ' Loop through cells just updated in our designated range For Each cell In rng ' If something in the cell, add date stamp to column A If cell <> "" Then Cells(cell.Row, "A") = Now() ' Clear column Y if column X is blank Else Cells(cell.Row, "A").ClearContents End If Next cell End Sub

Thanks Joe4....
I tip my virtually hat to you sir

much appreciated.

 

[Joe4]

You are welcome.