date stamp when cell changed

R

richardjshaffer

Board Regular
Joined
Oct 9, 2008
Messages
84
Hi,

hope someone can help, very simply I want to capture the date and time that a cell is changed.

So if the value in cell A2 is changed, then cell B2 date stamps with the current time; similiarly if cell A3 is changed, then cell B3 date stamps...

Tried looking at previous threads, I'm a bit confused by one that seems to work with a personal sub? Please can someone help, I'm no expert in macros but if there's a simple one I can use, or a formula based solution, I'd be very grateful,
thanks, Richard
 
Sort by date Sort by votes
Hi Lenze,

Thanks for the reply. Unfortunately I've got to chart the time taken between the changes in location (which will be the amendments made in the original cell), would this be possible from a comments box?

Mike
 
Upvote 0

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
No, not for charting puposes. The comment is only for informational purposes. But, what happens if a cell is changed twice"

lenze
 
Upvote 0
The cell would be changed at most 4 times ("locations"). I've got to identify when these changes happen, which is why I need to keep a record of the dates in consecutive cells. If the "Location" was changed while the spreadsheet remained open, it would be negligible enough to allow me to ignore it. If the sheet is saved I'd need a record of how long it had been between the change.

Thanks for the help though.

Mike
 
Upvote 0
RRAdmin,

Try:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A1000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim BC As Long
For BC = 2 To 5 Step 1
  If Target.Offset(, BC - 1) = "" Then
    With Target.Offset(, BC - 1)
      .Formula = Now
      .NumberFormat = "m/d/yyyy h:mm:ss AM/PM"
    End With
    Exit For
  End If
Next BC
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Upvote 0
I have a Date Stamp routine that maybe you can use.
It keeps track of however many change dates you want and records the total number of changes, the cell address that changed, and what the last from and to values were. Put the code in the ThisWorkbook code module
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
I have preset the parameters to meet your request.
<o:p></o:p>
Code: 
Option Explicit<o:p></o:p>
 <o:p></o:p>
 <o:p></o:p>
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)<o:p></o:p>
'NEEDS MORE TESTING<o:p></o:p>
'Date Stamp last changes specified<o:p></o:p>
'Records: Date stamps last specified number of times specified cells have changed<o:p></o:p>
'         Number of times cell has changed<o:p></o:p>
'         Cell address<o:p></o:p>
'         Change from value<o:p></o:p>
'         Chnnge to value<o:p></o:p>
'Include header optional<o:p></o:p>
 <o:p></o:p>
 <o:p></o:p>
    Dim DateStamp As Integer<o:p></o:p>
    Dim ChangeTo As Variant<o:p></o:p>
    Dim ChangeFrom As Variant<o:p></o:p>
    Dim DateStampNbrs As Integer<o:p></o:p>
    Dim DateStampLoc As Range<o:p></o:p>
    Dim rng As Range<o:p></o:p>
    Dim sDateStampRange As String<o:p></o:p>
    Dim sdateStampSheet As String<o:p></o:p>
    Dim bHeader As Boolean<o:p></o:p>
    Dim iCol As Integer<o:p></o:p>
    Dim msg As String<o:p></o:p>
    Dim ErrAt As String<o:p></o:p>
 <o:p></o:p>
    On Error GoTo ErrorHandler<o:p></o:p>
 <o:p></o:p>
    'Set Parameters<o:p></o:p>
    DateStampNbrs = 4                       'Number of changes to date stamp<o:p></o:p>
    Set DateStampLoc = Sheet1.Range("B2")   'First location to record date stamps<o:p></o:p>
    bHeader = True                          'Include header for date stamps True/False<o:p></o:p>
    sdateStampSheet = "Sheet1"              'Sheet on which cells are to be date stamped<o:p></o:p>
    sDateStampRange = "A2:A1000"            'Range of cells to be date stamped<o:p></o:p>
 <o:p></o:p>
    If sh.Name <> sdateStampSheet Then Exit Sub<o:p></o:p>
    If Intersect(Target, Sh.Range(sDateStampRange)) Is Nothing Or _<o:p></o:p>
       Target.Count > 1 Then Exit Sub<o:p></o:p>
    Application.ScreenUpdating = False<o:p></o:p>
    Application.EnableEvents = False<o:p></o:p>
 <o:p></o:p>
    'Chack to see if target really changed<o:p></o:p>
    ErrAt = " while cehcking cell change."<o:p></o:p>
    ChangeTo = Target.Value<o:p></o:p>
    Application.Undo<o:p></o:p>
    ChangeFrom = Target<o:p></o:p>
    Target.Offset(1).Select<o:p></o:p>
    If ChangeTo = ChangeFrom Then GoTo WrapUp<o:p></o:p>
    Target = ChangeTo<o:p></o:p>
 <o:p></o:p>
    'Build the header<o:p></o:p>
    ErrAt = " while Building Header."<o:p></o:p>
    If bHeader And DateStampLoc.Row > 1 Then<o:p></o:p>
        For iCol = 1 To DateStampNbrs<o:p></o:p>
            DateStampLoc.Offset(-1, iCol - 1) = "Date " & iCol<o:p></o:p>
        Next iCol<o:p></o:p>
        DateStampLoc.Offset(-1, DateStampNbrs) = "Times Changed"<o:p></o:p>
        DateStampLoc.Offset(-1, DateStampNbrs + 1) = "Cell Address"<o:p></o:p>
        DateStampLoc.Offset(-1, DateStampNbrs + 2) = "From"<o:p></o:p>
        DateStampLoc.Offset(-1, DateStampNbrs + 3) = "To"<o:p></o:p>
    End If<o:p></o:p>
 <o:p></o:p>
 <o:p></o:p>
    'Check date stamp first specified initial changes<o:p></o:p>
    ErrAt = " while checking for first specified Date Stamps."<o:p></o:p>
    For DateStamp = 1 To DateStampNbrs<o:p></o:p>
        If DateStampLoc.Offset(Target.Row - 2, DateStamp - 1) = "" Then GoTo Record_DateStamp<o:p></o:p>
    Next DateStamp<o:p></o:p>
 <o:p></o:p>
    'If reached this point then last specified days changes have been date stamped<o:p></o:p>
    'Shift last four date stamps left one cell<o:p></o:p>
    Target.Offset(, 2).Resize(1, DateStampNbrs - 1).Copy Target.Offset(, 1)<o:p></o:p>
    DateStamp = DateStamp - 1<o:p></o:p>
 <o:p></o:p>
Record_DateStamp:<o:p></o:p>
    ErrAt = " while posting date stamp information."<o:p></o:p>
    DateStampLoc.Offset(Target.Row - 2, DateStamp - 1).NumberFormat = "m/d/yyyy h:mm:ss AM/PM"<o:p></o:p>
    DateStampLoc.Offset(Target.Row - 2, DateStamp - 1) = Now<o:p></o:p>
 <o:p></o:p>
    'Record number of times cell has changed, target address and last change in cell<o:p></o:p>
    DateStampLoc.Offset(Target.Row - 2, DateStampNbrs) = _<o:p></o:p>
    DateStampLoc.Offset(Target.Row - 2, DateStampNbrs) + 1<o:p></o:p>
    DateStampLoc.Offset(Target.Row - 2, DateStampNbrs + 1) = Target.Worksheet.Name & " " & Target.Address<o:p></o:p>
    DateStampLoc.Offset(Target.Row - 2, DateStampNbrs + 2) = ChangeFrom<o:p></o:p>
    DateStampLoc.Offset(Target.Row - 2, DateStampNbrs + 3) = ChangeTo<o:p></o:p>
 <o:p></o:p>
    DateStampLoc.Offset(Target.Row - 2, DateStamp - 1).Resize(1, DateStampNbrs + 4).Columns.AutoFit<o:p></o:p>
    If bHeader And DateStampLoc.Row > 1 Then<o:p></o:p>
        DateStampLoc.Offset(-1).Resize(1, DateStampNbrs + 4).HorizontalAlignment = xlCenter<o:p></o:p>
        DateStampLoc.Offset(-1).Resize(Rows.Count, DateStampNbrs + 4).Columns.AutoFit<o:p></o:p>
 <o:p></o:p>
    End If<o:p></o:p>
 <o:p></o:p>
WrapUp:<o:p></o:p>
    Application.EnableEvents = True<o:p></o:p>
    Application.ScreenUpdating = True<o:p></o:p>
    Exit Sub<o:p></o:p>
ErrorHandler:<o:p></o:p>
    msg = "Error # " & Str(Err.Number) & " was generated by " _<o:p></o:p>
        & Err.Source & Chr(13) & Err.Description & ErrAt<o:p></o:p>
    MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext<o:p></o:p>
    GoTo WrapUp<o:p></o:p>
 <o:p></o:p>
[FONT=Times New Roman]End Sub[/FONT]
 
Last edited:
Upvote 0
Hi,

I know this thread is quite old but I was wondering if anyone would be able to help me?

I am trying to figure out a formula similar to the above except one slight difference; instead of putting the time stamp in the next cell, I would like the timestamp to appear in a specific box and change any time someone makes any amendment to the worksheet. Is this possible?

Many thanks

Fiona
 
Upvote 0
Hi Hiker95,

Your code has only changed 4 times.
If i change value 10 times and would like the last time the value will be changed in column 4.

Ex:
First time, value is date stamp in A2
Second time, value is date stamp in A3
Third time, value is date stamp in A4
4th time, value is date stamp in A5
5th time, value is date stamp in A5 (over write old value)
6th time, value is date stamp in A5 (over write old value)
7th time, value is date stamp in A5 (over write old value)
8th time, value is date stamp in A5 (over write old value)
9th time, value is date stamp in A5 (over write old value)
10th time, value is date stamp in A5 (over write old value)

hiker95 said:
RRAdmin,

Try:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A1000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim BC As Long
For BC = 2 To 5 Step 1
  If Target.Offset(, BC - 1) = "" Then
    With Target.Offset(, BC - 1)
      .Formula = Now
      .NumberFormat = "m/d/yyyy h:mm:ss AM/PM"
    End With
    Exit For
  End If
Next BC
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Click to expand...
 
Upvote 0
hiker95 said:
richardjshaffer,

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Adding the Macro
1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL+C
2. Right click the sheet tab you want the code in, and click on View Code. Paste the below code there (on the right pane) by pressing the keys CTRL+V
3. Press the keys ALT+Q to exit the Editor, and return to Excel.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A1000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
With Target.Offset(, 1)
  .Formula = Now
  .NumberFormat = "m/d/yyyy h:mm:ss AM/PM"
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Then make changes in column A, from cells A2 to A1000 (expand the A1000, in the above code, to the last address in column A that you will ever use).
Click to expand...

Hi,
I have been using the above code to record the date/time of a cell change for each row of my spreadsheet. It works perfectly for a single column of data. I now want to expand this to include other columns and have done so by changing the column letter (say A2:E1000) in the above code. However, because the date is recorded offset to the cell changed, a change to a cell in a different column writes the date in a different column. What I want to do is have the date overwrite the previous date. I tried to do this by using multiple, separate Worksheet_change routines but as I understand it I can only use one worksheet_change routine at a time.

How can I achieve this result?
 
Upvote 0
ATSJ,

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?


If you want the Worksheet_Change event macro code to check range A2:E1000 for changes, then, what column, to the right of column E, do you want the date and time written to?
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Count number of entries that have a date stamp of last week
Replies
6
Views
448
Joe4
Joe4
D
  • Question
VBA help to create button that moves to next row after taking screenshot
Replies
1
Views
123
ranman256
ranman256
S
  • Question
Identifying changes in 2 data sets
Replies
1
Views
232
JamesCanale
JamesCanale
D
  • Question
Copy the value of a cell onto another worksheet based on the dropdown selection
Replies
4
Views
131
mumps
mumps
B
  • Solved
Stop UDF/code from updating time when cell is edited
Replies
6
Views
339
Georgiboy
Georgiboy

Forum statistics

Threads
1,215,517
Messages
6,125,290
Members
449,218
Latest member
Excel Master

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top