Creating timestamp if cell range changes

[0rtli]

Hi guys,
So I need some help solving the issues.
I have data range from A2:Q and if in this range cell is empty R also should be empty, if A2:Q were filled with something, I would like to have a timestamp in column R.
Besides this, data in A2:Q can be copy&pasted so I found an old thread where VBA code works perfectly (without cleaning the timestamp when the cell is empty) but it can't handle when I'm bulk copy&pasting more than 1 row at the same time.

Old thread:

Creating a timestamp for changes made across a range of cells in a row

Hi! I want to track changes I have made on my worksheet by having a time stamp against each row. I have data from columns C to AX. I would like to have a timestamp in Column AY (only date would also work), if any value changes in any cell between C and AX. I found a couple of VBA codes which...

www.mrexcel.com

 

[Joe4]

But how do you handle conflicts, since you have multiple columns updating one column?
Like what if you were pasting multiple cells at once, like let's say A2 and B2, and A2 had a value, and B2 was blank.
So, would you want a timestamp in cell R2 (because of the value in A2), or R2 be cleared because of the blank put in cell B2?

 

[0rtli]

But how do you handle conflicts, since you have multiple columns updating one column?
Like what if you were pasting multiple cells at once, like let's say A2 and B2, and A2 had a value, and B2 was blank.
So, would you want a timestamp in cell R2 (because of the value in A2), or R2 be cleared because of the blank put in cell B2?

Thanks for your reply, according to your question, if any cell from A:Q range will be not empty then we need a timestamp in R.

 

[0rtli]

I think this code works perfectly well:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MyData As Range
Dim MyDataRng As Range
Set MyDataRng = Range("A2:A10")

If Intersect(Target, MyDataRng) Is Nothing Then Exit Sub

On Error Resume Next
If Target.Offset(0, 1) = "" Then
    Target.Offset(0, 1) = Now
End If


For Each MyData In MyDataRng
    If MyData = "" Then
        MyData.Offset(0, 1).ClearContents
    End If
    
Next MyData

End Sub

Just need to adjust that the range is A2:Q and the timestamp column is R accordingly to A2:Q rows.

 

[Joe4]

Your current code is only set-up to check one cell in one column. That is easy.
Trying to checking multiple columns in multiple rows is a bit trickier.

Try something like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim r As Long
    Dim rng2 As Range
  
'   See if any cells in watched range updated
    Set rng = Intersect(Columns("A:Q"), Target)
    If rng Is Nothing Then Exit Sub
  
    Application.EnableEvents = False
  
'   Loop through all cells in range
    For Each cell In rng
'       Get row of update
        r = cell.Row
'       Check to make show update is not in row 1
        If r > 1 Then
'           Build range to check
            Set rng2 = Range(Cells(r, "A"), Cells(r, "Q"))
'           Check to see if any cells in row have a value
            If Application.WorksheetFunction.Count(rng2) > 0 Then
                Cells(cell.Row, "R").Value = Now()
            Else
'               Clear timestamp if all blank
                Cells(cell.Row, "R").ClearContents
            End If
        End If
    Next cell

    Application.EnableEvents = True
  
End Sub

Note that if you are updating multiple columns and rows at once, the code will loop more than it needs to (as it loops through each cell), though it will still work.

 

[0rtli]

Your current code is only set-up to check one cell in one column. That is easy.
Trying to checking multiple columns in multiple rows is a bit trickier.

Try something like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim r As Long
    Dim rng2 As Range
  
'   See if any cells in watched range updated
    Set rng = Intersect(Columns("A:Q"), Target)
    If rng Is Nothing Then Exit Sub
  
    Application.EnableEvents = False
  
'   Loop through all cells in range
    For Each cell In rng
'       Get row of update
        r = cell.Row
'       Check to make show update is not in row 1
        If r > 1 Then
'           Build range to check
            Set rng2 = Range(Cells(r, "A"), Cells(r, "Q"))
'           Check to see if any cells in row have a value
            If Application.WorksheetFunction.Count(rng2) > 0 Then
                Cells(cell.Row, "R").Value = Now()
            Else
'               Clear timestamp if all blank
                Cells(cell.Row, "R").ClearContents
            End If
        End If
    Next cell

    Application.EnableEvents = True
  
End Sub

Compile error:
Invalid outside procedure.

 

[Joe4]

Compile error:
Invalid outside procedure.

Sounds like a copy error.
May you copied something extra (maybe my explanation) or maybe you missed a part.

 

[Joe4]

Also, can you tell us which version of Excel you are using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[0rtli]

Sounds like a copy error.
May you copied something extra (maybe my explanation) or maybe you missed a part.

Looks like working perfectly but.
the whole code works only for numbers, when I enter the text, the timestamp won't appears.

 

[0rtli]

Also, can you tell us which version of Excel you are using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Done, thanks for mentioning this part.