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

Question

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

[This](https://stackoverflow.com/questions/71180/how-can-i-find-last-row-that-contains-data-in-a-specific-column) and [This](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) may prove useful — cybernetic.nomad, Jan 24 '20 at 17:02
@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. — greenster10, Jan 24 '20 at 17:17
@user11982798 Exactly! Do you have an idea how the code would look like? — greenster10, Jan 24 '20 at 17:32
but it is important, that the time stamp always gets inserted into the last row of column A — greenster10, Jan 24 '20 at 17:33

user11982798 · Answer 1 · 2020-01-25T13:36:58.557

1

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

edited Jan 25 '20 at 13:36

answered Jan 24 '20 at 18:10

user11982798

1,878
1
6
8

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 – greenster10 Jan 24 '20 at 19:01
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: https://docs.google.com/spreadsheets/d/1OU_95Lhf6p0ju2TLlz8xmTegHpzTYu4DW0_X57mObBc/edit#gid=0 – greenster10 Jan 25 '20 at 09:34
1

@user1192798, I try it, 1 Moment! :) – greenster10 Jan 25 '20 at 11:14
@user1192798 i updated my google sheet, what if i want to have a second date History in my sheet? how would the code look then? should I open a new question and send you the link so you get extra reputation for it? – greenster10 Jan 25 '20 at 12:34
can you make a 3rd update under the 2 you already made and show me? I don't understand what you mean with monitoring – greenster10 Jan 25 '20 at 13:05
1

https://stackoverflow.com/questions/59909571/creating-multiple-data-histories-with-excel-vba-using-lastrow-time-stamp-and-wo post your update here, so you get extra reputation my friend! – greenster10 Jan 25 '20 at 13:16
1

post this anwer here too: https://stackoverflow.com/questions/59909571/creating-multiple-data-histories-with-excel-vba-using-lastrow-time-stamp-and-wo so I can give u more reputation! I will try if it works, thank you! – greenster10 Jan 25 '20 at 13:46
I now get the following error: Run-time error '1004' : Method 'Range' of object'_Global' failed – greenster10 Jan 27 '20 at 09:18
Run-time error '1004' : Method 'Range' of object'_Global' failed in this row: ```Range("Evaluation!B" & LastRow & ":F" & LastRow).Value = Range("CheckList!A" & target.Row & ":E" & target.Row).Value``` – greenster10 Jan 27 '20 at 09:27
can you show me a fitting code? I don't really undertstand – greenster10 Jan 27 '20 at 09:30
ok it turned yellow after debugging and Last Row is 583 in my document and Range the error code... – greenster10 Jan 27 '20 at 09:35
the target.row value is 3 – greenster10 Jan 27 '20 at 09:37
exactly yes, so what should I do? – greenster10 Jan 27 '20 at 09:39
Just 1 target at the moment – greenster10 Jan 27 '20 at 09:42
https://stackoverflow.com/questions/59928172/run-time-error-1004-method-range-of-object-global-failed-in-a-vba-code-w?noredirect=1#comment105979089_59928172 I use this code right now, my new workbook is too big to copy it – greenster10 Jan 27 '20 at 09:44
ok I decided to use your first update, but now I have multiple rows, I updated my googlesheet, how does the code look now? – greenster10 Jan 27 '20 at 10:41
yes i Updated the google sheet right now and wrote an update notice, so how would the new code look like? could you past a new update? – greenster10 Jan 27 '20 at 10:51
It only copies the rows that get changed, but it should copy the whole rows from A2:E17 – greenster10 Jan 27 '20 at 11:07
I update my code, so u can see it in my question: the code i post only copies the row in which the change took place, so f.e. A3:E3, but it should copy A3:E17, no matter where the change took place – greenster10 Jan 27 '20 at 11:57
remove all merge first, what dou you mean by that? – greenster10 Jan 27 '20 at 12:10
do you have an example? – greenster10 Jan 27 '20 at 12:14
do you have a code for that? where do I have to insert it in my code? – greenster10 Jan 27 '20 at 12:22

score 0 · Answer 2 · answered Jan 28 '20 at 01:55

0

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

answered Jan 28 '20 at 01:55

user11982798

1,878
1
6
8

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 – greenster10 Jan 28 '20 at 12:32
does this code copy the whole area A1:E17 no matter where the change happened in this area? – greenster10 Jan 28 '20 at 12:42
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 – greenster10 Jan 28 '20 at 12:43
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 – greenster10 Jan 28 '20 at 12:45
https://docs.google.com/spreadsheets/d/1OU_95Lhf6p0ju2TLlz8xmTegHpzTYu4DW0_X57mObBc/edit#gid=0 I updated my google sheet to show you what I mean, this is now the final version – greenster10 Jan 28 '20 at 13:14
what do you mean? Did you Check the google sheet? You think this is possible? – greenster10 Jan 28 '20 at 13:22
I updated it, this is the final version now, you think a code for this is possible? – greenster10 Jan 28 '20 at 13:25
yes because right now, the code only copies one row and I thought maybe like this it always copies all rows from A1:E17 – greenster10 Jan 28 '20 at 13:29
As you know mytarget is long number – user11982798 Jan 28 '20 at 13:30
do you have a code for my explicit example in the google sheet? – greenster10 Jan 28 '20 at 13:36

score 0 · Accepted Answer · answered Jan 29 '20 at 00:34

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

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

3 Answers3

Linked