Running time stamp column each time a specific cell changes.

Hootywho

Board Regular
Joined
Oct 11, 2010
Messages
90
Hello, I have searched and not come up with anything I can modify for my purpose. I have a specific cell "B321" that has a formula and changes regularly throughout the day based on entries elsewhere within the workbook. This cell value can change as many as 250 times from open to close. My goal is to have a seperate worksheet (hidden) named "timestamp info" collect in column "A" the value of B321 when it initially changes from "" and column "B" would show actual time this event occured. Columns A & B would continue to collect this info each time B321 changes.

Many Thanks
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Create the "timestamp info" worksheet by hand, make the top row bold and freeze it. Paste the following code into the code module for your main worksheet - the one where B321 changes. Change the bit in red to match the name of your main worksheet.
Code:
[FONT=Courier New][SIZE=1]Option Explicit[/SIZE][/FONT]
 
[FONT=Courier New][SIZE=1]Private Sub Worksheet_Calculate()[/SIZE][/FONT]
 
[FONT=Courier New][SIZE=1] Dim iLastRow As Long[/SIZE][/FONT]
[SIZE=1][FONT=Courier New] Dim tsi As Worksheet[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] Dim mws As Worksheet[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New] Set tsi = ThisWorkbook.Sheets("timestamp info")[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] tsi.Range("A1") = "New Value"[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] tsi.Range("B1") = "Date/Time Changed"[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] iLastRow = tsi.Cells(tsi.Rows.Count, 1).End(xlUp).Row[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New] Set mws = ThisWorkbook.Sheets("[COLOR=red][B]Sheet1[/B][/COLOR]")[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New] If mws.Range("B321").Value <> tsi.Cells(iLastRow, 1).Value Then[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]   tsi.Cells(iLastRow + 1, 1) = mws.Range("B321").Value[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]   tsi.Cells(iLastRow + 1, 2) = Format(Now(), "dd/mm/yyyy hh:nn:ss")[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] End If[/FONT][/SIZE]
 
[FONT=Courier New][SIZE=1]End Sub[/SIZE][/FONT]
Let me know if you have any problems.
 
Last edited:
Upvote 0
Hey Ruddles, Thanks for the earlier code. I have code that generates email and sends an Array of sheets, it will not work with a hidden sheet. I also cannot protect the cells from being changed with your code.

With that said.....how would I modify your code to have the same action take place excepting the changed value in cell B321 and timestamp are now located on the same worksheet in a different location? My thoughts there are to locate this information in an obscure place within the worksheet where it will not be tampered with, not having the ability to lock the cells.

Thanks for your help.
 
Upvote 0
To place the log starting from M25:-
Code:
[FONT=Courier New][SIZE=1]Option Explicit[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]Private Sub Worksheet_Calculate()[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]  Dim iLastRow As Long
  Dim mws As Worksheet
  
  Set mws = ThisWorkbook.Sheets("[COLOR=red][B]Sheet1[/B][/COLOR]")
  mws.Range("[COLOR=blue][B]M25[/B][/COLOR]") = "New Value"
  mws.Range("[COLOR=blue][B]N25[/B][/COLOR]") = "Date/Time Changed"
  iLastRow = mws.Cells(mws.Rows.Count, "[COLOR=blue][B]M[/B][/COLOR]").End(xlUp).Row
  
  
  If mws.Range("B321").Value <> mws.Cells(iLastRow, "[COLOR=blue][B]M[/B][/COLOR]").Value Then
    mws.Cells(iLastRow + 1, "[COLOR=blue][B]M[/B][/COLOR]") = mws.Range("B321").Value
    mws.Cells(iLastRow + 1, "[COLOR=blue][B]N[/B][/COLOR]") = Format(Now(), "dd/mm/yyyy hh:nn:ss")
  End If[/SIZE][/FONT]
[FONT=Courier New][SIZE=1][/SIZE][/FONT] 
[FONT=Courier New][SIZE=1]End Sub[/SIZE][/FONT]
 
Upvote 0
The code will work equally well in Excel 2007.
 
Upvote 0
Hi, First time poster long time reader.

I am looking for something very similar except I am looking to capture the value of the changing cell at specific times throughout the day. For example, would like to capture the value of the changing cell at 720AM, 2PM, 4PM and 5PM. I would like to capture this information is a separate workbook although I do not need it hidden. Would be ideal if the data was collected in a separate column on a daily basis, however this last part is not as important.

I have had no luck in my search for a solution to this. I responded to this thread because it was the closest I could get to my issue.

Any assistance would be much appreciated.

Thanks
 
Upvote 0
Create the "timestamp info" worksheet by hand, make the top row bold and freeze it. Paste the following code into the code module for your main worksheet - the one where B321 changes. Change the bit in red to match the name of your main worksheet.
Code:
[FONT=Courier New][SIZE=1]Option Explicit[/SIZE][/FONT]
 
[FONT=Courier New][SIZE=1]Private Sub Worksheet_Calculate()[/SIZE][/FONT]
 
[FONT=Courier New][SIZE=1]Dim iLastRow As Long[/SIZE][/FONT]
[SIZE=1][FONT=Courier New]Dim tsi As Worksheet[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim mws As Worksheet[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]Set tsi = ThisWorkbook.Sheets("timestamp info")[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]tsi.Range("A1") = "New Value"[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]tsi.Range("B1") = "Date/Time Changed"[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]iLastRow = tsi.Cells(tsi.Rows.Count, 1).End(xlUp).Row[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]Set mws = ThisWorkbook.Sheets("[COLOR=red][B]Sheet1[/B][/COLOR]")[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]If mws.Range("B321").Value <> tsi.Cells(iLastRow, 1).Value Then[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] tsi.Cells(iLastRow + 1, 1) = mws.Range("B321").Value[/FONT][/SIZE]
[SIZE=1][FONT=Courier New] tsi.Cells(iLastRow + 1, 2) = Format(Now(), "dd/mm/yyyy hh:nn:ss")[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]End If[/FONT][/SIZE]
 
[FONT=Courier New][SIZE=1]End Sub[/SIZE][/FONT]
Let me know if you have any problems.

I have used the above and it works perfectly!
My issue is I am creating a coin book and would like to run the same code for more than one cell being updated (different denominations) and with a chosen description as well.
I've used the following modification for the singular cell to achieve this for 5 cent bags,

Option Explicit

Private Sub Worksheet_Calculate()

Dim iLastRow As Long
Dim tsi As Worksheet
Dim mws As Worksheet

Set tsi = ThisWorkbook.Sheets("Timestamp Info")
tsi.Range("A1") = "Description"
tsi.Range("B1") = "New Value"
tsi.Range("C1") = "Date/Time Changed"

iLastRow = tsi.Cells(tsi.Rows.Count, 1).End(xlUp).Row

Set mws = ThisWorkbook.Sheets("Sheet1")

If mws.Range("B1").Value <> tsi.Cells(iLastRow, 1).Value Then
tsi.Cells(iLastRow + 1, 1) = "changed total 5 cent bags"
tsi.Cells(iLastRow + 1, 3) = Format(Now(), "dd/mm/yyyy hh:nn:ss")
tsi.Cells(iLastRow + 1, 2) = mws.Range("B1").Value
End If

End Sub



This runs perfectly for what I wish to do however when I try to duplicate the code, only the second code runs (10 cent bags) even when the 1st codes cell is the one that has been altered.



Option Explicit

Private Sub Worksheet_Calculate()

Dim iLastRow As Long
Dim tsi As Worksheet
Dim mws As Worksheet

Set tsi = ThisWorkbook.Sheets("Timestamp Info")
tsi.Range("A1") = "Description"
tsi.Range("B1") = "New Value"
tsi.Range("C1") = "Date/Time Changed"

iLastRow = tsi.Cells(tsi.Rows.Count, 1).End(xlUp).Row

Set mws = ThisWorkbook.Sheets("Sheet1")

If mws.Range("B1").Value <> tsi.Cells(iLastRow, 1).Value Then
tsi.Cells(iLastRow + 1, 1) = "changed total 5 cent bags"
tsi.Cells(iLastRow + 1, 3) = Format(Now(), "dd/mm/yyyy hh:nn:ss")
tsi.Cells(iLastRow + 1, 2) = mws.Range("B1").Value
End If
If mws.Range("B2").Value <> tsi.Cells(iLastRow, 1).Value Then
tsi.Cells(iLastRow2 + 1, 1) = "changed total 10 cent bags"
tsi.Cells(iLastRow2 + 1, 3) = Format(Now(), "dd/mm/yyyy hh:nn:ss")
tsi.Cells(iLastRow2 + 1, 2) = mws.Range("B2").Value
End If

End Sub


Any help at all would be appreciated, happy to give more info if needed.
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,967
Members
452,371
Latest member
Frana

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