Independant time stamps ...

[AudBall]

Hail Excel-lent ones. I've used this site often in the past to much success, but I've found a problem I'm not sure how to work around.

I need two independent time stamps to be auto-filled based on the completion of adjacent cells. This part works in generating the stamps, but updates when the stamps when reopened. These are the formulas:

=IF(ISBLANK(C7),"",IF(ISBLANK(C8),"",IF(ISBLANK(E8),"",NOW())))

=IF(ISBLANK(C12),"",IF(ISBLANK(C13),"",IF(ISBLANK(C14),"",IF(ISBLANK(E12),"",IF(ISBLANK(E13),"-",NOW())))))

I know key strokes can be used to generate a time stamp, but this form will be used by people with general familiarity of Excel or less. I've used code from this site before to prevent time stamps from updating, but I'm not certain how to make this happen on a two part form. I know a macro button could work too, but I need to force compliance in this case, (i.e. it won't be stamped complete until all required fields are populated).

Any help on this issue would be appreciated.

Thank you.

 

[Eric W]

Sounds like a job for Worksheet_Change!!

If you use a formula in a cell, it WILL update when the sheet recalculates. If you use a worksheet change event, every time a cell is updated, the macro can check to see if those cells are populated, and if so, insert a date.

Here's how to create such a macro. Press Alt-F11 to open the VBA editor. Then double-click on the sheet tab on the left side of the screen. Then paste this macro:

Private Sub Worksheet_Change(ByVal target As Range)
Dim MyRange1 As Range, MyRange2 As Range
Dim MyDate1 As Range, MyDate2 As Range


    Set MyRange1 = Range("C7,C8,E8")
    Set MyRange2 = Range("C12,C13,C14,E12,E13")
    Set MyDate1 = Range("A1")
    Set MyDate2 = Range("A2")
    
    If Not Intersect(target, MyRange1) Is Nothing Then
        For Each cel In MyRange1
            If cel = "" Then GoTo Check2:
        Next cel
        MyDate1 = Date & " " & Time
    End If
    
Check2:
    If Not Intersect(target, MyRange2) Is Nothing Then
        For Each cel In MyRange2
            If cel = "" Then Exit Sub
        Next cel
        MyDate2 = Date & " " & Time
    End If
    
End Sub

You can see at the top of the macro where to put your cell ranges. If anyone ever changes one of your target cells, then the date will change.

Let me know how it works.

 

[AudBall]

That worked perfectly. Thank you. I really appreciate it.

 

[AudBall]

Updated code to allow the time stamps to remain protected; thought I would share. It's sad, but gotta keep honest people honest.

Private Sub Worksheet_Change(ByVal target As Range)
Dim MyRange1 As Range, MyRange2 As Range
Dim MyDate1 As Range, MyDate2 As Range


    Set MyRange1 = Range("C7,C8,E8")
    Set MyRange2 = Range("C12,C13,C14,E12,E13")
    Set MyDate1 = Range("E7")
    Set MyDate2 = Range("C15")
    
    If Not Intersect(target, MyRange1) Is Nothing Then
        For Each cel In MyRange1
            If cel = "" Then GoTo Check2:
        Next cel
        ActiveSheet.Unprotect Password:="12345"
        MyDate1 = Date & " " & Time
        ActiveSheet.Protect Password:="12345", DrawingObjects:=False, Contents:=True, Scenarios:= _
        True
    ActiveSheet.EnableSelection = xlUnlockedCells
    End If
    
Check2:
    If Not Intersect(target, MyRange2) Is Nothing Then
        For Each cel In MyRange2
            If cel = "" Then Exit Sub
        Next cel
        ActiveSheet.Unprotect Password:="12345"
        MyDate2 = Date & " " & Time
        ActiveSheet.Protect Password:="12345", DrawingObjects:=False, Contents:=True, Scenarios:= _
        True
    ActiveSheet.EnableSelection = xlUnlockedCells
    End If
    
End Sub

Again, thank you for your help.