PDA

View Full Version : [SOLVED] VBA to insert Now() when formula result changes



fpt264
02-26-2016, 04:46 AM
I am attempting to write code which will insert Now() in cell L16 whenever the result of the formula in M19 changes due to entries elsewhere on the sheet. In my quest if found code written by mdmackillop posted on this forum which monitors the calculated value in E8 (E6+E7=E8) and repeats that value in E9 and changes the background color of E9 whenever the value in E8 changes due to an entry in E6 or E7. This is the closest thing to what I need that I have been able to find. Here is the code I am referring to:



Option Explicit
'Create variable to hold values
Dim Monitored

Private Sub Worksheet_Activate()
Monitored = Range("E8").Value 'Read in value prior to any changes
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Check target to determine if macro is triggered
If Intersect(Target, Union(Range("E6"), Range("E7"))) Is Nothing Then Exit Sub
'Prevent looping of code due to worksheet changes
Application.EnableEvents = False
'Compare monitored cell with initial value
If Range("E8").Value <> Monitored Then
'Do things as a result of a change
DoThings
'Reset Variable with new monitored value
Monitored = Range("E8").Value
End If
'Reset events
Application.EnableEvents = True
End Sub

Private Sub DoThings()
With Range("E9")
.Formula = Range("E6") + Range("E7")
If .Interior.ColorIndex = 6 Then
.Interior.ColorIndex = 8
Else: .Interior.ColorIndex = 6
End If
End With
End Sub

So my question is how can I modify this to monitor cell M19 and if its value changes insert Now() in L16?

excelliot
02-26-2016, 05:12 AM
why you want to insert
now() ?

excelliot
02-26-2016, 05:21 AM
I guess, you need below.. paste this code in worksheet module..



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range


' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("M19")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then


' Display a message when one of the designated cells has been
' changed.
' Place your code here.
Range("L16").Value = Time

End If
End Sub




Cheers!!

fpt264
02-26-2016, 07:14 AM
Thanks for the reply. This code doesn't change the time when the formula returns a new result but I can change the Key Cells to the range where the data is entered and do it that way.

mikerickson
02-26-2016, 07:25 AM
Try this



Private Sub Worksheet_Change(ByVal Target As Range)

Set KeyCells = Range("M19")

On Error Resume Next
Set KeyCells = Application.Union(KeyCells, KeyCells.Precedents)
On Error Goto 0

If Not Application.Intersect(Target, KeyCells) Is Nothing Then
Range("L16").Value = Now
End If

End Sub

Note that the time stamp will appear anytime that a precedent cell is changed, NOT when the value in M19 is changed.

For example, if M19 has the formula =ABS(A1) and the user changes A1 from -1 to 1, the value in M19 will not be changed, but the time stamp will appear.

fpt264
02-26-2016, 08:19 AM
At first I got an error which I was able to correct by adding the line "Dim KeyCells As Range". At this point this appears to insert the date and time (I am using Now() formatted to m/d/yyyy h:mm AM/PM).

If this works like I think it is this would be exactly what I wanted. Thanks for your help.

fpt264
02-26-2016, 10:07 AM
mikerickson,
Your code is working as desired, however I find that the time stamp will not update when I have sheet protection on even thought I have unlocked the cell the timestamp goes in. I need to keep Protection on and specific cells unlocked for data entry. Can you suggest a fix for this? Below is the code as I am using it.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("M19")
On Error Resume Next
Set KeyCells = Application.Union(KeyCells, KeyCells.Precedents)
On Error GoTo 0
If Not Application.Intersect(Target, KeyCells) Is Nothing Then
Range("L16").Value = Now
End If
End Sub

excelliot
02-29-2016, 04:59 AM
you can add code before and after for locking & unlocking sheet..

so your code will look like this..



Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("M19")
On Error Resume Next
Set KeyCells = Application.Union(KeyCells, KeyCells.Precedents)
On Error GoTo 0
If Not Application.Intersect(Target, KeyCells) Is Nothing Then
ActiveSheet.Protect Password:="excelliot"
Range("L16").Value = Now
ActiveSheet.Unprotect Password:="excelliot"
End If
End Sub


cheers!!