1

I am working on a worksheet that will enter static date and time in an excel worksheet when a value is typed in a target cell. However, the worksheet will be used where values are copied from a downloaded file and pasted to the macro worksheet. When values are typed, the date and time worked as expected but if values are pasted, the VBA code does not work, it has to be typed. How can I make that possible?

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

        If Not Intersect(Target, Range("C2:C100")) Is Nothing Then

            With Target(1, -1)

                .Value = Date

                .EntireColumn.AutoFit

            End With

        End If

End Sub
doubleD
  • 269
  • 1
  • 12
  • 1
    `If Target.Cells.Count > 1 Then Exit Sub` will exit the sub if multiple cells are copied in. remove it, then loop the target and place the date where you want it. – Scott Craner Apr 16 '21 at 17:54
  • `With Target(1, -1)` --->. probably clearer to use `Offset` here. – BigBen Apr 16 '21 at 17:55
  • 1
    `If Not Intersect(Target, Range("C2:C100")) Is Nothing Then` (with multi-cell Target allowed) will process the whole of Target, even if only part of Target in in ColC. – Tim Williams Apr 16 '21 at 18:44

2 Answers2

1

Something like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, c As Range
    
    'any updates to C2:C100 ?
    Set rng = Application.Intersect(Target, Me.Range("C2:C100"))
    
    If Not rng Is Nothing Then
        'loop over all updated cells
        For Each c In rng.Cells
            c.Offset(0, -2).Value = Date
        Next c
        rng.Offset(0, -2).EntireColumn.AutoFit
    End If

End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • 1
    @BigBen ...and `Range("C2")(0, 0).Address` is B2 which surprised me and is why I'd never use this notation. Fixed my code above, thanks. – Tim Williams Apr 16 '21 at 20:38
0

Add Date Stamp on Cell Change

  • Pick one.

Easy

Private Sub Worksheet_Change(ByVal Target As Range)

    Const cFirst As String = "C2"
    Const dCol As String = "A"

    Dim rg As Range
    Set rg = Range(cFirst).Resize(Rows.Count - Range(cFirst).Row + 1)
    Set rg = Intersect(Target, rg)

    If Not rg Is Nothing Then
        ' Since you cannot manually paste a non-contiguous range
        ' (you can copy one), you can get away with the following line:
        rg.EntireRow.Columns(dCol).Value = Date
        rg.EntireColumn.AutoFit
    End If

End Sub

Hard

Private Sub Worksheet_Change(ByVal Target As Range)

    Const cFirst As String = "C2"
    Const dCol As String = "A"

    ' Create a reference to the column range from 'cFirst'
    ' to the bottom-most cell in the worksheet.
    Dim rg As Range: Set rg = Intersect(Target, _
        Range(cFirst).Resize(Rows.Count - Range(cFirst).Row + 1))

    If rg Is Nothing Then Exit Sub

    ' If you plan to populate the cells via VBA, then you could write
    ' non-contiguously to the column range,
    ' e.g. with 'Range("C3,C5:C7,C10:20").value = 1'.
    ' Then you could use the following:
    Dim dDate As Date: dDate = Date
    Dim arg As Range
    For Each arg In rg.Areas
        arg.EntireRow.Columns(dCol).Value = dDate
    Next arg

    rg.EntireColumn.AutoFit

End Sub

Tough

Private Sub Worksheet_Change(ByVal Target As Range)
    addDateStamp Target, "C2", "A"
End Sub

' This is usually, but not necessarily, located in a standard module.
Sub addDateStamp( _
        ByVal TargetRange As Range, _
        ByVal FirstCellAddress As String, _
        ByVal DateStampColumn As String)
    
    If Not TargetRange Is Nothing Then
        
        Dim rg As Range
        With TargetRange.Worksheet.Range(FirstCellAddress)
            Set rg = .Resize(.Worksheet.Rows.Count - .Row + 1)
        End With
        Set rg = Intersect(TargetRange, rg)
        
        If Not rg Is Nothing Then
            Dim dDate As Date: dDate = Date
            Dim arg As Range
            For Each arg In rg.Areas
                arg.EntireRow.Columns(DateStampColumn).Value = dDate
            Next arg
            rg.EntireColumn.AutoFit
        End If
    
    End If
    
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28