Automatically trigger code when formulas change

[dell_12345]

Hi, Iv got some very basic VBA coding that will copy a cell value to another cell every time the original cell value changes. However this only works when I manually change the cell value. I want this to change automatically as it is linked to another sheet which is changing constantly. Below is my code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long
Dim vaData() As Variant
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub


ReDim vaData(1 To 1, 1 To 3)
vaData(1, 1) = Now()
vaData(1, 2) = Target.Address
vaData(1, 3) = Target.Resize(1, 1).Value
Application.EnableEvents = False
With Sheets("Sheet2")
    lRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    .Range("A" & lRow & ":C" & lRow).Value = vaData
End With
Application.EnableEvents = True
End Sub

People are saying use the Worksheet_Calculate function but I have no idea how to implement this in the above code.

Greatful for any help!!!!

 

[eduzs]

Private Sub Worksheet_Calculate()

Remove:

If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub

 

[dell_12345]

Private Sub Worksheet_Calculate()

Remove:

If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub

Hi this doesnt appear to do much? Thankyou for your time though.

 

[Lobsterboy1]

Try this

Private Sub Worksheet_Calculate()
    Dim target As Range
    Dim lRow As Long
    Dim vaData() As Variant
    Set target = Range("B1")
    If Not Intersect(target, Range("B1")) Is Nothing Then
        ReDim vaData(1 To 1, 1 To 3)
        vaData(1, 1) = Now()
        vaData(1, 2) = target.Address
        vaData(1, 3) = target.Resize(1, 1).Value
        Application.EnableEvents = False
    With Sheets("Sheet2")
        lRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & lRow & ":C" & lRow).Value = vaData
    End With
    End If
End Sub

 

[dell_12345]

Try this

Private Sub Worksheet_Calculate()
    Dim target As Range
    Dim lRow As Long
    Dim vaData() As Variant
    Set target = Range("B1")
    If Not Intersect(target, Range("B1")) Is Nothing Then
        ReDim vaData(1 To 1, 1 To 3)
        vaData(1, 1) = Now()
        vaData(1, 2) = target.Address
        vaData(1, 3) = target.Resize(1, 1).Value
        Application.EnableEvents = False
    With Sheets("Sheet2")
        lRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & lRow & ":C" & lRow).Value = vaData
    End With
    End If
End Sub

Cheers for your time Lobster. It worked the first time the cell changed value but didn't work after this but it is on the right lines.

 

[RoryA]

That's because that code disables events but never re-enables them. You could use something like this:

Private Sub Worksheet_Calculate()
Dim lRow As Long
Dim vaData() As Variant
Dim Target As Range

set target = Range("B1")

ReDim vaData(1 To 1, 1 To 3)
vaData(1, 1) = Now()
vaData(1, 2) = Target.Address
vaData(1, 3) = Target.Value
Application.EnableEvents = False
With Sheets("Sheet2")
    lRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    .Range("A" & lRow & ":C" & lRow).Value = vaData
End With
Application.EnableEvents = True
End Sub

Note that you will first need to re-enable events by either restarting Excel, or running code like this:

Sub ResetEvents()
application.enableevents = True
End sub

Note also that the calculate event may occur whether or not the value of B1 actually changed. If that is an issue you would need to store the old value and check against that before copying the new data.

 

[dell_12345]

Thankyou Rory, Unfortunately as you suggested the cell value in B1 was copied even if it hadn't changed resulting in constant copying of the cell. Again on the right lines but only want to record the cell value when it has actually changed. Thankyou all for your time on this, will be a relief when its fixed lol.

 

[RoryA]

You could use something like this

Private Sub Worksheet_Calculate()
Dim lRow As Long
Dim vaData() As Variant
Dim Target As Range

set target = Range("B1")

if CStr(target.value) <> target.id then
target.id = CStr(target.value)
ReDim vaData(1 To 1, 1 To 3)
vaData(1, 1) = Now()
vaData(1, 2) = Target.Address
vaData(1, 3) = Target.Value
Application.EnableEvents = False
With Sheets("Sheet2")
    lRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    .Range("A" & lRow & ":C" & lRow).Value = vaData
End With
Application.EnableEvents = True
end if
End Sub

 

[dell_12345]

RoryA my friend you are an absolute genius....that has saved me months work!!! Thankyou all who looked and took the time to try and solve the problem, Rory i owe u a beer!!!!!

 

[dell_12345]

Hi,

So I have a bit of code that records a cell every time it changes value thanks to some help on this forum. However to enhance what im trying to record I want to record the value of a number of cells but only when the original cell changes value as before. I.e if cell A1 changes value I want the values of B1 and C1 to be recorded as well. Current code below:

Private Sub Worksheet_Calculate()Dim lRow As Long
Dim vaData() As Variant
Dim Target As Range


Set Target = Range("G36")


If CStr(Target.Value) <> Target.ID Then
Target.ID = CStr(Target.Value)
ReDim vaData(1 To 1, 1 To 3)
vaData(1, 1) = Now()
vaData(1, 2) = Target.Address
vaData(1, 3) = Target.Value
Application.EnableEvents = False
With Sheets("Sheet2")
    lRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    .Range("A" & lRow & ":C" & lRow).Value = vaData
End With
Application.EnableEvents = True
End If
End Sub

Thankyou in advance for any help.