Stamping current date when row data changes

[Craig Pohlman]

Hi,

I am trying to get a cell in a particular column to change to the current
date, but only when any other data in that row is changed. Each cell in
that column then should have the last date that a cell was changed in that
row. We need to be able to perserve the current manual entry of dates last
updated in that column until the next change is made in that row.

I see some talk here about this Worksheet_Change sub, but not quite sure how
to change that to get the result I am looking for. I am sort of new to
writing VB in macros, so you'll have to forgive my lack of knowledge, hoping
someone can steer me to a good solution. Thanks

Craig

 

[Dave Peterson]

Take a look at JE McGimpsey's site:
http://www.mcgimpsey.com/excel/timestamp.html

 

[ryguy7272]

This is worth a look too:
Function MyUserName() As String
MyUserName = Environ("UserName")
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("$A$1:$BB$4000")) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
With Worksheets("Sheet2")
..Select
..Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Target.Address
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Target.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Now()
ActiveCell.NumberFormat = "mm/dd/yy"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = MyUserName()
Application.EnableEvents = True
Application.ScreenUpdating = True
End With
End If
End Sub

This is neat too:
Dim vOldVal 'Must be at top of module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bBold As Boolean
Dim rArea As Range
Dim rCell As Range
For Each rArea In Target.Areas
For Each rCell In rArea
'your individual cell code here
Next rCell
Next rArea


If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
bBold = Target.HasFormula
With Sheet1
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:E1") = Array("CELL CHANGED", "OLD VALUE", _
"NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE")
End If


With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = vOldVal
With .Offset(0, 2)
If bBold = True Then
.ClearComments
.AddComment.Text Text:= _
"OzGrid.com:" & Chr(10) & "" & Chr(10) & _
"Bold values are the results of formulas"
End If
.Value = Target
.Font.Bold = bBold
End With

.Offset(0, 3) = Time
.Offset(0, 4) = Date
End With
.Cells.Columns.AutoFit
'.Protect Password:="Secret"
End With
vOldVal = vbNullString

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

On Error GoTo 0
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
vOldVal = Target
End Sub


Regards,
Ryan---