Add a date 3 columns to the Left of copy/pasted range

[Chipperzs]

I have a date column (C) and a series of columns that users add information into. Usually one row at a time. I've created a Worksheet Module that runs when the value in column (G) is updated (it changes the value in column C to equal Now())

Private Sub Worksheet_Change(ByVal areaOfInterest As Range)
' This is for the auto inputed date that apears in Column C after updating information in Column D
' This defines which column activates the action
If areaOfInterest.Column = 7 Then
' This defines which rows are active
If areaOfInterest.Row > 3 Then
' This sets which cell "relative the activation cell" gets changed and to what
areaOfInterest.Offset(0, -4) = Now
' This sets the fomat for the cell that gets changed
' areaOfInterest.Offset(0, -2).NumberFormat = "ddd"
End If
End If
End Sub

This works fine until someone wants to Copy and Past information into column G. Actual Copy/past works too but only if the information being coped/pasted is one column wide. If the information being pasted is two columns wide then two columns get updated (C & D get's updated with a date). And this continues for each additional column width pasted in to the cell in column G (One row but 5 columns of info pasted in column G and the current date is updated for the same row in columns C,D,E,F,G).

What I want is to be able to past several columns worth of information into the cell in column G and have only the cell in column C update.
It would be nice if:
1) you could copy/past one row or several rows of information at the same time and have each row that info is entered in to for column G get today's date updated in column C.
2) If there was a date already entered in column C that the value was not updated.

Thanks in advance!

 

[HalfAce]

Hi, welcome to the board.
It may be as easy as changing this line:

areaOfInterest.Offset(0, -4) = Now

to something more like:

If ActiveCell.Offset(0, -4) = "" Then ActiveCell.Offset(0, -4) = Date

The use of 'ActiveCell' here will limit what you're doing to only be done 4 cells to the left of the upper left most cell of whatever range you have selected. (Or the cell you have selected if only one.) Meaning you can paste as many columns as you like starting in column G, but 'ActiveCell' is only looking at column G, so the offset will only refer to column C.
Also, you'll see where I added the condition to only update Col. C with the date if Col. C is blank.

Does this help at all?

 

[AlphaFrog]

Private Sub Worksheet_Change(ByVal areaOfInterest As Range)
    Dim rngC As Range
    ' This is for the auto inputed date that apears in Column C after updating information in Column D
    ' This defines which column activates the action
    If Not Intersect(Range("G4:G" & Rows.Count), areaOfInterest) Is Nothing Then
        Set rngC = Intersect(Range("G4:G" & Rows.Count), areaOfInterest).Offset(, -4)
        On Error Resume Next
        Application.EnableEvents = False
        Intersect(Columns("C").SpecialCells(xlCellTypeBlanks), rngC) = Now
        Application.EnableEvents = True
        On Error GoTo 0
    End If
End Sub

 

[Chipperzs]

AlfaFrog!

Thanks so much...

And thanks for the quick response guys.

I copied/pasted the code in and it works like a charm!

 

[Chipperzs]

Some comments:
-HalfAce
Your fix works but only for the first row. If I copy and past more than one row of info into column G only the top row will get a date updated in column C. Works great though.

-AlphaFrog
Your fix works the way I want it to but when I go to insert rows into the spreadsheet the code updates the blank column C with a date even though there is no info inputted (copy/pasted) into column G.

I think that if AlphaFrog's code is edited to add a check to see if the cells in column G are "" then no update to column C.

 

[AlphaFrog]

Private Sub Worksheet_Change(ByVal areaOfInterest As Range)
    Dim rngC As Range
    ' This is for the auto inputed date that apears in Column C after updating information in Column D
    ' This defines which column activates the action
    If Not Intersect(Range("G4:G" & Rows.Count), areaOfInterest) Is Nothing Then
        On Error Resume Next
        Application.EnableEvents = False
        Set rngC = Intersect(Range("G4:G" & Rows.Count).SpecialCells(xlCellTypeConstants), areaOfInterest).Offset(, -4)
        Intersect(Columns("C").SpecialCells(xlCellTypeBlanks), rngC) = Now
        Application.EnableEvents = True
        On Error GoTo 0
    End If
End Sub