Record cell change and date

kayakginge

New Member
Joined
Dec 11, 2017
Messages
19
Hi All,

I have had a read through other posts can cant find exactly what i am after, i can find script for each individual part but when i try and put them together i can can only get one half to work.

I would like to monitor target cells in another sheet and record the value that was in the target cell and record it in another sheet in column B and the date the change was made in column A.

So it would look something like this.

Sheet 1

Cell B19 is changed from 12 to 13 on the 20/11/18

sheet 2

A1 would now read 20/11/18
B1 would now read 12

Next time sheet 1 B19 is changed from 13 to 14

sheet 2

A2 would read date changed
B2 would read 13

i would like to do this for a number of target cells and record them in different columns, i assume this will just be a matter of copy and pasting the code.

Ie also record changes in sheet 1 B20 and first previous value would be stored in sheet 2 C1 and date in D1 etc

Any help on this would be greatly appreciated and i thank you in advance. If this is not clear enough please let me know.

Many thanks
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Well I know how to do this if for example you enter 12 into B19 Then cell A2 in sheet 2 could now be 12

But your wanting to enter 13 into B19 and enter 12 into sheet 2 A2

You wanting what was in the cell before it was changed not what was just entered into the cell.

That if it can be done is not something I would know how to do.
 
Last edited:
Upvote 0
Hi,

This will start to record in line 2 so you have a title line to recall what cell you record.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vOld 'Old value
Dim vNew 'New Value
Dim vTime
Dim lr As Long 'Last Row
Dim sht As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
    If Intersect(Target, Range("B19:B20")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
        vNew = Target.Value
        Application.Undo
        vOld = Target.Value
        Target.Value = vNew
        vTime = Format(Now(), "dd/mm/yy")
        Set sht = Worksheets("Sheet2")
        If Target = Range("B19") Then
            lr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
            sht.Range("A" & lr + 1) = vTime
            sht.Range("B" & lr + 1) = vOld
        End If
        If Target = Range("B20") Then
            lr = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row
            sht.Range("C" & lr + 1) = vTime
            sht.Range("D" & lr + 1) = vOld
        End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
For data analysis, I would recommand to record on 4 columns: 1 the cell name, 2 the date, 3 the old 4 The new value. You can then filter per cell.
In term of code it is much easier as well: for any cell in target range, do that.
 
Upvote 0
Well I know how to do this if for example you enter 12 into B19 Then cell A2 in sheet 2 could now be 12

But your wanting to enter 13 into B19 and enter 12 into sheet 2 A2

You wanting what was in the cell before it was changed not what was just entered into the cell.

That if it can be done is not something I would know how to do.

I am happy for the cell to enter 12 instead of previous value, i just need a record.

many thanks
 
Upvote 0
I have tried the code Kamolga and nothing happens. No runtime errors but no numbers either.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vOld 'Old value
Dim vNew 'New Value
Dim vTime
Dim lr As Long 'Last Row
Dim sht As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
If Intersect(Target, Range("B6:F62")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
vNew = Target.Value
Application.Undo
vOld = Target.Value
Target.Value = vNew
vTime = Format(Now(), "dd/mm/yy")
Set sht = Worksheet("Sheet15")
If Target = Range("C21") Then
lr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
sht.Range("A" & lr + 1) = vTime
sht.Range("B" & lr + 1) = vOld
End If
If Target = Range("D15") Then
lr = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row
sht.Range("C" & lr + 1) = vTime
sht.Range("D" & lr + 1) = vOld
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
Upvote 0
The easiest way is to right click the sheet1 name and click view code ans paste my macro.

If you have a sheet2, it will work.

Hi Kamolga,

Thanks for you responses.

I have tried this in the sheet view code, it is still not working.

Target sheet is sheet 2 recording sheet is sheet 15
 
Upvote 0
-I opened a new book
-inserted a new page which is called Sheet2
-put some values into C21 and d15 of this sheet
-I renamed sheet1 into Sheet15
-right clicked Sheet2 and clicked view code
-Pasted your code
-Had an error (s in red missing)
Code:
[COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
[COLOR=#333333]Dim vOld 'Old value[/COLOR]
[COLOR=#333333]Dim vNew 'New Value[/COLOR]
[COLOR=#333333]Dim vTime[/COLOR]
[COLOR=#333333]Dim lr As Long 'Last Row[/COLOR]
[COLOR=#333333]Dim sht As Worksheet[/COLOR]
[COLOR=#333333]Application.EnableEvents = False[/COLOR]
[COLOR=#333333]Application.ScreenUpdating = False[/COLOR]
[COLOR=#333333]If Intersect(Target, Range("B6:F62")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub[/COLOR]
[COLOR=#333333]vNew = Target.Value[/COLOR]
[COLOR=#333333]Application.Undo[/COLOR]
[COLOR=#333333]vOld = Target.Value[/COLOR]
[COLOR=#333333]Target.Value = vNew[/COLOR]
[COLOR=#333333]vTime = Format(Now(), "dd/mm/yy")[/COLOR]
Set sht = Worksheet[COLOR=#ff0000]s[/COLOR]("Sheet15")
[COLOR=#333333]If Target = Range("C21") Then[/COLOR]
[COLOR=#333333]lr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row[/COLOR]
[COLOR=#333333]sht.Range("A" & lr + 1) = vTime[/COLOR]
[COLOR=#333333]sht.Range("B" & lr + 1) = vOld[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]If Target = Range("D15") Then[/COLOR]
[COLOR=#333333]lr = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row[/COLOR]
[COLOR=#333333]sht.Range("C" & lr + 1) = vTime[/COLOR]
[COLOR=#333333]sht.Range("D" & lr + 1) = vOld[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]Application.ScreenUpdating = True[/COLOR]
[COLOR=#333333]Application.EnableEvents = True[/COLOR]
[COLOR=#333333]End Sub[/COLOR]
-change values in C21 and D15 and it works!!!

Note:
1. If you delete a cell and put value, you get a line without value because previous value was empty, but you get today's date
2. Sheet15 is the name the user see in excel, not the name of the object in VBA
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,003
Messages
6,122,655
Members
449,091
Latest member
peppernaut

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