Creating a data history with Excel VBA using LastRow, Time Stamp and Workbook.sheetchange

I have programmed a manual macro in Excel VBA that displays a table to show the history of certain data in a sheet called "evaluation". The data i reference to is in the table "checklist".(Look below) The problem is that the data in "checklist" changes every day or more often. Every time the sheet changes the macro should insert a new row with a new date into the LastRow of the table in "evaluation". (I googled and I found the possibility to use a Timestamp, see below and the function Workbook.Sheetchange, that should activate this macro every time the worksheet gets changed, see below). I would like to display a history of the data in "evaluation". So the values in the row of the last change should stay stable. So for example row 1 in "evaluation": 2020-01-17 value is 1 (this should stay 1, because i want to see the progress) Now the sheet changes and row 2 gets inserted: row 2: 2020-01-18 value is now 2 (copied from checklist) and i want the value in row 1 to stay at 1 (because it was 1 before the last change). Right now it looks like this:

Sub Test()
'
' Test Macro
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "='checklist'!R[399]C[58]"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "='checklist'!R[399]C[58]"

End Sub

timestamp:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("'checklist'!BH400:BL500")) Is Nothing Then
      Cells(Target.Row, 1) = Format(Now, "DD/MM/YYYY  hh:mm")
   End If
End Sub

workbook.sheetchange:

Private Sub Workbook_SheetChange(ByVal Sh As Object, _ 
 ByVal Source As Range) 
 ' runs when a sheet is changed 
End Sub

Do you have any ideas how to connect these codes? Sorry I am not really a VBA expert. I made a google sheet to show what I actually mean, but I need this in excel VBA, the google sheet is just to visualize what I mean: https://docs.google.com/spreadsheets/d/1OU_95Lhf6p0ju2TLlz8xmTegHpzTYu4DW0_X57mObBc/edit#gid=0

THis is my code right now:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "Checklist" Then
          'Monitoring from A3:E100, if different change this
          If Not Intersect(target, Range("A2:E1000")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If
    End If
End Sub


Private Sub Test(target As Range)
    Dim LastRow As Long

    LastRow = Range("Evaluation!A" & Sheets("Evaluation").Rows.Count).End(xlUp).Row

    If Range("Evaluation!A1").Value <> "" Then
       LastRow = LastRow + 1
    End If
    'every change A3:E in checklist will insert row to this evaluation
    'but if different please you decide here
    Range("Evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
    Range("Evaluation!B" & LastRow & ":F" & LastRow).Value = Range("Checklist!A" & target.Row & ":E" & target.Row).Value
End Sub

Here to monitor CheckList!A1:H4 and copy CheckList!J3:N5 to Evaluation empty row of Column A entirely:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "CheckList" Then
          'Monitoring from CheckList!A1:H4, if different change this

          If Not Intersect(target, Range("CheckList!A1:H4")) Is Nothing Then
             Test target 'Here procedure to insert
          End If
    End If
End Sub


Private Sub Test(target As Range)
    Dim LastRow As Long

    Dim myCol As Long
    Dim myRow As Long
    myCol = target.Column

    If myCol >= 1 And myCol <= 8 Then
    If Range("Evaluation!A1") = "" Then Range("Evaluation!A1") = "History"
    If Range("Evaluation!A2") = "" Then Range("Evaluation!A2") = "Date"
        LastRow = Range("Evaluation!A" & Sheets("Evaluation").Rows.Count).End(xlUp).Row

        'In this situation, all J3 to N5 will be copied
        'if different, please modify as actual range
        Dim myRange As Range
        Set myRange = Range("CheckList!J3:N5")
        For a = 1 To myRange.Rows.Count
            LastRow = LastRow + 1
            Range("Evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm")
            Range("Evaluation!B" & LastRow & ":F" & LastRow).Value = myRange.Rows(a).Value
        Next a
    End If
End Sub

Event Macros, Worksheet Events and Workbook Events, Security set to Medium: If you have never run macros before, make sure that your Excel 2007 and 2010 Event macros must be in the workbook you use them in -- this If you are validating data entered you can use change - the Target argument a timestamp into the double-clicked cell you can use the following macro. The “Now” function returns current date and time, and “Format” function formats the output into "mm/dd/yyyy HH:mm:ss" format. Show date and time whenever a change is made using VBA. Let's say you have prepared a sheet. In this sheet, you want time to be shown in column B whenever someone does an entry Column A.

Here the code you need

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "checklist" Then
          If Not Intersect(target, Range("BH400:BL500")) Is Nothing Then
             Cells(target.Row, 1) = Format(Now, "DD/MM/YYYY  hh:mm")
             Test target
          End If
    End If
End Sub

Private Sub Test(target As Range)
    Dim LastRow As Long

    LastRow = Range("evaluation!A" & Sheets("evaluation").Rows.Count).End(xlUp).Row

    If Range("evaluation!A1").Value <> "" Then
       LastRow = LastRow + 1
    End If
    Range("evaluation!A" +LastRow).Value = "=NOW()"
    Range("evaluation!B" +LastRow).Value = Range("CheckList!B" & Target.row)
    Range("evaluation!C" +LastRow).Value= "1"
    Range("evaluation!D" +LastRow).Value= Range("CheckList!D" & Target.row)
End Sub

Update as your google sheet

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "CheckList" Then
          'Monitoring from A3:E100, if different change this
          If Not Intersect(target, Range("A3:E100")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If
    End If
End Sub


Private Sub Test(target As Range)
    Dim LastRow As Long

    LastRow = Range("Evaluation!A" & Sheets("Evaluation").Rows.Count).End(xlUp).Row

    If Range("Evaluation!A1").Value <> "" Then
       LastRow = LastRow + 1
    End If
    'every change A3:E in checklist will insert row to this evaluation
    'but if different please you decide here
    Range("Evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
    Range("Evaluation!B" & LastRow & ":F" & LastRow).Value = Range("CheckList!A" & target.Row & ":E" & target.Row).Value
End Sub

Next Update

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "CheckList" Then
          'Monitoring from A3:E100, if different change this
          If Not Intersect(target, Range("A3:E100")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If
          If Not Intersect(target, Range("G3:K100")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If
    End If
End Sub


Private Sub Test(target As Range)
    Dim LastRow As Long

    Dim myCol As Long
    myCol = target.Column

    If myCol >= 1 And myCol <= 5 Then
        LastRow = Range("Evaluation!A" & Sheets("Evaluation").Rows.Count).End(xlUp).Row

        If Range("Evaluation!A1").Value <> "" Then
           LastRow = LastRow + 1
        End If
        'every change A3:E in checklist will insert row to this evaluation
        'but if different please you decide here
        Range("Evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
        Range("Evaluation!B" & LastRow & ":F" & LastRow).Value = Range("CheckList!A" & target.Row & ":E" & target.Row).Value
    End If
    If myCol >= 7 And myCol <= 11 Then
        LastRow = Range("Evaluation!H" & Sheets("Evaluation").Rows.Count).End(xlUp).Row

        If Range("Evaluation!H1").Value <> "" Then
           LastRow = LastRow + 1
        End If
        'every change A3:E in checklist will insert row to this evaluation
        'but if different please you decide here
        Range("Evaluation!H" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
        Range("Evaluation!I" & LastRow & ":M" & LastRow).Value = Range("CheckList!G" & target.Row & ":K" & target.Row).Value
    End If
End Sub

How to insert current timestamp when data in another cell changes , In the worksheet you need to modify VBA code: Insert current data in column C, the timestamp Kutools for Excel Solves Most of with password; Create Mailing if the excel file you're using is a and so on until the last row. 1. Press the Alt + F11 keys simultaneously to open the Microsoft Visual Basic for Applications window. 2. In the Microsoft Visual Basic for Applications window, click Insert > Module. Then copy and paste the below VBA code into the Code window. See screenshot: VBA code: Insert timestamp into specific cell when Macro is run

You must have general module (not object module), if no, insert new module, and put this:

Public myLastRow As Long
Public myTarget As Long

Public Function CheckMe(target As Long)
    CheckMe = ""
    Range("Evaluation!A:F").UnMerge
    LastRow = Range("Evaluation!A" & Sheets("Evaluation").Rows.Count).End(xlUp).Row
    If Range("Evaluation!A1").Value <> "" Then
       LastRow = LastRow + 1
    End If
    myLastRow = LastRow
    myTarget = target
End Function

Call the function in cell G3 by formula:

=LEFT(A3&B3&C3&D3&E3&F3&CheckMe(ROW(A3)),0)

Copy Cell G3 to G4:G1000 (or as your last possible row)

Last, in ThisWorkBook Module as we use before, clear all code, and add this code:

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    If myTarget < 3 Then Exit Sub
    Range("Evaluation!A:F").UnMerge

    Range("Evaluation!A" & myLastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
    Range("Evaluation!B" & myLastRow & ":F" & myLastRow).Value = Range("Checklist!A" & myTarget & ":E" & myTarget).Value
    myLastRow = 0
    myTarget = 0
End Sub

And do test

Active questions tagged excel - Stack Overflow, 01/27/20--05:43: Creating a data history with Excel VBA using LastRow, Time Stamp found the possibility to use a Timestamp, see below and the function Workbook.Sheetchange, that should activate this macro every time the worksheet gets� When you use the NOW function in that formula it appears that it is also attaching the time to the date. If you then use that data for a pivot table with column headers to be the date you exceed the number of days as it makes an entry for every time stamp instead of every day. Is there an easy fix for this?

Workbook.SheetChange event (Excel), expression An expression that returns a Workbook object. Parameters. Parameters. Name, Required/Optional, Data type, Description Have questions or feedback about Office VBA or this documentation? Blog � Contribute � Privacy & Cookies � Terms of Use � Site Feedback � Trademarks; � Microsoft 2020 . 1 Creating multiple data histories with Excel VBA using LastRow, Time Stamp and Workbook.sheetchange Jan 25. 1 How to use Poiters (References) in a VBA For Each Loop?

How To Trigger Your VBA Macros To Run Based On A Specific Cell , To get to the "coding area" of either your workbook or worksheet, you simply Excel VBA Change Event Handler Trigger Macro Code I choose to use the Change Event Handler to make this happen. What I am looking for is the exact time stamp (data not so required as I Range("A" & lastrow + 1). Excel 2003, Windows 7 . I’m using a bit of VBA to automatically time & date stamp a cell whenever values are updated in any one of several adjacent cells on the same Row. Right click tab name, “View Code”, and we get: Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Application.EnableEvents = False For Each c In Target

SCRIPT NEEDED, You will then not need an onEdit based timestamp script at all. you will have to use two lines of code, and do some math to get the date and time separately. have full rights to all the data, which does not sound like the best solution. Have you considered creating a form instead of sharing a spreadsheet? Here's a screen shot of our data in Excel: So, every time we change a value in the "Number1" column, a time stamp is updated in the "Last Changed" column Here's the code we need to use in the worksheet module: Explanation Worksheet_Change is an event that is fired off when a cell's value is changed

Comments
  • This and This may prove useful
  • @user11982798 sorry that was a mistake, I edited the code now in the question, so when a value in the table "checklist"!BH400:BL500 changes, the timestamp (Then Cells(Target.Row, 1) = Format(Now, "DD/MM/YYYY hh:mm")) should be activated and inserted in the LastRow of the sheet "evaluation" and the last row should be filled with data. The Value in C3:C is always 1, yes, but the values in row D3:D change, that is why I want to see the progress.
  • @user11982798 Exactly! Do you have an idea how the code would look like?
  • but it is important, that the time stamp always gets inserted into the last row of column A
  • look at last another answer
  • it does not work yet, it inserts the new date in the "checklist" in col A, but the date should be inserted in the last row of "Evaluation" in colA and each time in a new row, so lastRow+1 I guess. And in the same row of the date, the new changed values from checklist have to be inserted
  • The thing is, the last row in column A with the new data in col b, col c, col d, col e should be inserted automatically by the macro in "evaluation", I made a google sheet to show you what I mean, but I basically need this in excel VBA: docs.google.com/spreadsheets/d/…
  • @user1192798, I try it, 1 Moment! :)
  • stackoverflow.com/questions/59909571/… post your update here, so you get extra reputation my friend!
  • post this anwer here too: stackoverflow.com/questions/59909571/… so I can give u more reputation! I will try if it works, thank you!
  • ok man, I think we do not need the Calculate Function, I thought about it, you have to edit the "r", so we just move the area that gets checked to the area, where "r" is edited, but there is still the problem, that not the whole area with the data gets copied, only 1 row... so it would be better to use the old formula and extend it
  • does this code copy the whole area A1:E17 no matter where the change happened in this area?
  • It works but it only copies 1 row for example A3:E3, but it always should copy A1:E17 with a timestamp before each row
  • Range("Evaluation!B" & myLastRow & ":F" & myLastRow).Value = Range("Checklist!A1" & myTarget & ":E1" & myTarget).Value .... Range("Evaluation!B" & myLastRow & ":F" & myLastRow).Value = Range("Checklist!A" & myTarget & ":E" & myTarget).ValueRange("Evaluation!B" & myLastRow & ":F" & myLastRow).Value = Range("Checklist!A2" & myTarget & ":E2" & myTarget).Value...... Range("Evaluation!B" & myLastRow & ":F" & myLastRow).Value = Range("Checklist!A17" & myTarget & ":E17" & myTarget).Value
  • docs.google.com/spreadsheets/d/… I updated my google sheet to show you what I mean, this is now the final version