Date stamp when cell value changes

[GDunn]

Hi,

I would like to date stamp a range of cells in column H, when the value on the same row in column G is changed to = "Yes". Have created a Worksheet_Change, but am unable to fix the column H change part.

Private Sub Worksheet_Change(ByVal Target As Range)
With Range("G34:G310")
For Each Cell In Range("G34:G" & ActiveCell.SpecialCells(xlCellTypeLastCell).Row)
Select Case Cell.Value
Case Is = "Yes"
Cell("H34:H").Value = Int(Now)
End Select
Next Cell
End With
End Sub

Thanks in advance

 

[AlphaFrog]

Try something like this...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("G34:G310"), Target) Is Nothing Then
        If LCase(Target.Value) = "yes" Then Target.Offset(, 1).Value = Date
    End If
End Sub

It works if the user types in yes in G34:G310. It doesn't work if a formula returns Yes.

 

[GDunn]

Thanks Alpha.
Was looking for a date stamp when formula = "Yes". As vale will change from "No" to "Yes"

 

[AlphaFrog]

What is the formula?

Does the user do something to another cell that causes the formula to return yes\no? If yes, what cell?

We could use that range to trigger off of.

 

[GDunn]

There are many variations. This is one example:

=IF(AND(C19<>"",Cabling!J11=""),"No","yes")

 

[AlphaFrog]

Put this formula in H34 and copy it down to H310

=IF(G34="Yes",TODAY(),"")

Then put this in the ThisWorkbook module. It "locks in" the date from the formula when the workbook is saved.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim cell As Range
    For Each cell In Sheets("Sheet1").Range("G34:G310").SpecialCells(xlCellTypeFormulas)
        If cell.Value <> "" Then cell.Value= cell.Value
    Next cell
End Sub

Change the "Sheet1" in the code to the name of the worksheet you want this to work on.

 

[GDunn]

Thanks AlphaFrog, that's excellent.

 

[AlphaFrog]

Sorry. The code should be this...

For Each cell In Sheets("Sheet1").Range("[COLOR="Red"]H[/COLOR]34:[COLOR="Red"]H[/COLOR]310").SpecialCells(xlCellTypeFormulas)

 

[GDunn]

AlhpaFrog the solution works, but when I hit save it continualy loops through the range until I hit Escape.
Can this be fixed?

Thanks for your help

 

[AlphaFrog]

Did you delete the previous Worksheet_Change procedure?