Auto update of date

[georgecheng]

I'm looking for a way that when entering data in an cell in column A the current date to automatically appear in column T. I want the date to be a fixed.
After saving the sheet, the next time I open it the dates/times will still have to be the same as they were the first time.
Can anyone help me with this?
Thanks

 

[Richard Schollar]

HI

Right-click on the tab name in the main Excel window and select View COde. Paste the following into the code module that will open up. Back in the sheet, every time you enter a value in col A, the corresponding cell in col T will be updated with today's date. If you delete a value in col A, col T will also be cleared.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, cell As Range
Set r = Intersect(Range("A:A"), Target)
If Not r Is Nothing Then
    Application.EnableEvents = False
    For Each cell In r
        If Not IsEmpty(cell.Value) Then
            With Cells(cell.Row, "T")
                .Value = Date
                .NumberFormat = "dd mmm yyyy"
            End With
        Else
            Cells(cell.Row, "T").ClearContents
        End If
    Next cell
    Application.EnableEvents = True
End If
End Sub

 

[Simon Lloyd]

This goes in the worksheet module

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
 If Target.Cells.Count > 1 Then Exit Sub
If Target <> "" Then
Target.Offset(0, 19).Value = Date
End If
End Sub

 

[georgecheng]

Thanks RichardSchollar, it works. Is there anyway to do this without using code, but using formula etc?

BTW, simon, what do you mean in the worksheet module. This is the first time I using code under excel.

 

[Richard Schollar]

There's no way to keep the date 'fixed' by using formulas (AFAIK).

By worksheet module Simon was referring to the same place that you posted my code to

 

[Simon Lloyd]

Richard you are right, there would still have to be a UDF!

 

[Boller]

Can avoid looping each cell ;-

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Range("A:A"), Target)
If Not r Is Nothing Then
    Application.EnableEvents = False
    r.Offset(, 19) = Date
    On Error Resume Next
    r.SpecialCells(xlCellTypeBlanks).Offset(, 19).ClearContents
    On Error GoTo 0
    Application.EnableEvents = True
End If
End Sub