简体   繁体   中英

How do I enter the date/time stamp in specific column when a cell is changed in the same row of that column?

I have an Excel sheet with columns A:N that can be filled with text.

When any of those cells are filled with text, I would like cell O (of that same row) to be updated with a date/timestamp.

The solutions I have seen use the "offset" function but I cannot use that.

Private Sub Worksheet_Change(ByVal Target As Range) 

    If Intersect(Target, Range("A1:O1000")) Is Nothing Then Exit Sub 

    Target.Offset(x,y).Value = Date 

End Sub

Add Time Stamp to Rows of Changed Cells

Sheet Module (eg Sheet1 )

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const sCols As String = "A:N" ' Source Columns
    Const dCol As String = "O" ' Destination Column
    Const FirstRow As Long = 2
    
    Dim rCount As Long: rCount = Rows.Count - FirstRow + 1
    Dim rOffset As Long: rOffset = FirstRow - 1

    Dim sRng As Range ' Source Range
    Set sRng = Intersect(Columns(sCols).Resize(rCount).Offset(rOffset), Target)
    
    If Not sRng Is Nothing Then
        
        Dim TimeStamp As Date: TimeStamp = Now
        Dim dcRng As Range ' Destination Column Range
        Set dcRng = Columns(dCol).Resize(rCount).Offset(rOffset)
        
        Dim dRng As Range ' Destination Range
        Dim aRng As Range ' Area Range
        
        For Each aRng In sRng.Areas
            If dRng Is Nothing Then
                Set dRng = Intersect(aRng.EntireRow, dcRng)
            Else
                Set dRng = Union(dRng, Intersect(aRng.EntireRow, dcRng))
            End If
        Next aRng
        
        Application.EnableEvents = False
        dRng.Value = TimeStamp
        Application.EnableEvents = True
    
    End If
        
End Sub

Sub testNonContiguous()
    ' No time stamp in cell 'O1' if 'FirstRow > 1'.
    Range("A1,C4,F11").Value = 1
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM