Need Timestamp in column C whenever column B cell value changes (same row)

[Vbalearner85]

Hi VBA Gurus,

I want macro to record timestamp in column C whenever value in column B changes (column B is formula based upon value in column A-corresponding row).

I have below macro which does the job, but changes timestamp even if column B value is same, but column A value changes.
I need timestamp in column C to change only when column B value changes (not column A). Seeking your expertise, as I am still new to VBA

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xCellColumn As Integer
Dim xTimeColumn As Integer
Dim xRow, xCol As Integer
Dim xDPRg, xRg As Range
xCellColumn = 2
xTimeColumn = 3
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumn Then
Cells(xRow, xTimeColumn) = Now()
Else
On Error Resume Next
Set xDPRg = Target.Dependents
For Each xRg In xDPRg
If xRg.Column = xCellColumn Then
Cells(xRg.Row, xTimeColumn) = Now()
End If
Next
End If
End If
End Sub

 

[JoeMo]

If your col A values are input manually and calculation is on automatic, this should do what you want:

Dim Prev As String
Dim lR As Long
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A" & lR)) Is Nothing Then
    If Cells(Target.Row, "B") <> Prev Then
        Application.EnableEvents = False
        Cells(Target.Row, "C").Value = Now
        Application.EnableEvents = True
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
lR = Range("B" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("A2:A" & lR)) Is Nothing Then
    Prev = Cells(Target.Row, "B")
End If
End Sub

 

[Vbalearner85]

A is not manual Input,but linked to data from other sheet..which changes dynamically(system fetched data).

Above code works great for manual input as you mentioned, but I am looking for formula driven change....

 

[Vbalearner85]

Looking for the solution still...Please assist..

 

[mikerickson]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xDPRg As Range
    Dim yDPRg as Range

    Application.EnableEvents = False
    On Error Resume Next

    Set yDPRg = Application.Intersect(Target,Range("A:A"))
    Set xDPRg = Target.Dependents
    Set xDPRg = yDPrg
    Set xDPRg = Application.Union(yDPrg, Target.Dependents)
    Set xDPRg = Application.Intersect(xDPRg, Range("A:A"))
  
    Application.Intersect(Range("B:B").EntireColumn,  xDPRg.EntireRow).Value = Now()
    On Error Goto 0

    Application.EnableEvents = True
End Sub

 

[Vbalearner85]

Finally managed to have vba solution for above after some digging in...Thanks community for the support..

So macro does the job for formulas directed data in column A and pastes timestamp for instance of every change in column B (column C step not needed for my purpose..so removed it)


Private Sub Worksheet_Calculate()
Dim Cell As Range
For Each Cell In Range("A1:A142")
If Cell.Value <> Cell.Offset(0, 8).Value Then
Cell.Offset(0, 1).Value = Now
Cell.Offset(0, 8).Value = Cell.Value
End If
Next
Columns("B:B").EntireColumn.AutoFit
End Sub