Auto Fill Cell Value added by "Copy N Paste"

**bdb1974** · 05-01-2009, 12:11 PM

Hi all,

I've got this macro, that will auto fill in the "username" (Col. J),and the date (Col. K), When a value is "typed" into the column I for the same row.

If I "Copy N Paste" the same value down column I for any given number of rows, the data will not autofill in to (Col.J&K). This only happens when a
value is typed.

Is there a way to fix this so it will auto fill when, a value is "Copied and Pasted"?

Also, how would I set the range for this to happen for row 9 and down.
I don't want the auto fill happening in rows 1-8.

I've attached an example layout.
Here's the code I'm working with:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim x As Range
    If Target.Column = 9 Then
    Cells(Target.Row, "J").Select
     ActiveCell.Offset(0, 0) = Environ("USERNAME")
    ActiveCell.Offset(0, 1) = Date & Time
    End If
End Sub

Thanks.

bdb

**shg** · 05-01-2009, 12:36 PM

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim cell As Range
    
    Set r = Intersect(Target, Columns("I"))
    If r Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    For Each cell In r
        Cells(cell.Row, "J") = Environ("username")
        Cells(cell.Row, "K") = Now
    Next cell
    Application.EnableEvents = True
End Sub

**bdb1974** · 05-01-2009, 02:48 PM

SHG,Works like a charm.

But there remains an issue. Actually 2.

How do I keep the autopost from happening in rows 1-8?

and, how do I get it to work with adding this bit of code to the macro.

 If Target.Column = 12 Then
     Cells(Target.Row, "M").Select
    ActiveCell.Offset(0, 0) = Environ("USERNAME")
    ActiveCell.Offset(0, 1) = Date & Time
    End If
       If Target.Column = 15 Then
     Cells(Target.Row, "P").Select
    ActiveCell.Offset(0, 0) = Environ("USERNAME")
    ActiveCell.Offset(0, 1) = Date & Time
    End If

I don't need this bit of code to auto fill down with a copy'n paste because,
the values in L & O will be added per individual rows.

Sorry, for not including this segment with the first post. I didn't think that
it would stop working.

Thanks,

bdb

**shg** · 05-01-2009, 03:02 PM

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r       As Range
    Dim cell    As Range

    Set r = Intersect(Target, _
                      Range("I:I,L:L,O:O"), _
                      Rows(9).Resize(Rows.Count - 8))
    If r Is Nothing Then Exit Sub

    Application.EnableEvents = False
    For Each cell In r
        With cell
            .Offset(, 1).Value = Environ("username")
            .Offset(, 2).Value = Now
        End With
    Next cell
    Application.EnableEvents = True
End Sub