Tuesday, May 26, 2015

Updating a Date field to Today

A fun read...

Recently, thanks to an email from Chandoo.org, I read a Today() ain't so bad... at Daily Dose of Excel.  It discussed, with a nice bit of humor, the need to add an effective date to a work sheet with what we used to call this "Idiot Proofing".  Now we call it "Executive Proofing",

As if there were a difference!

Something new...

As usual, there was a suggestion about using CTL-; (Control key with the Semi-colon) to insert the current date.  No complaints about that.  It wasn't that long ago I learned this little trick, and just a week or so ago someone pointed out that with CTL-SemiColon and CTL-Colon separated by a space you get a nice timedatestamp!

The "Something new" was putting Today() in a DataValidation dropdown, an idea gleaned from LinkedIn group "ExcelHero".

  • Name a cell "TodayIs" (or whatever name you like, or ignore the naming thing)
  • Enter "=Today()" in the TodayIs cell.
  • Enter a prompting-value in the cell where you want them to include the date.  Label it, too.
  • In the cell(s) where you want to today's date to be entered, create a DataValidation with a list pointing to TodayIs
Here it is in action... (kinda)

That said, here are a few other ideas...

If it is always a new workbook, i.e. not an update of a current work book whether saved with a new name or not,  make a template where the A1 says "Click Me!" and A1 is Named "ClickMe".  Then in the worksheet module put this code.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("ClickMe")) Is Nothing Then
        If Intersect(Target, Range("ClickMe")) = Range("ClickMe") _
            And UCase(Range("ClickMe").Value) = "CLICK ME!" Then
                Range("Clickme").Value = Format(Now(), "m/d/yyyy")
        End If
    End If
End Sub

If you prefer to use the BeforeDoubleClick event, then try
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If ActiveCell = Range("LastChangeDate") Then
        Select Case MsgBox("Keep change and update the worksheet to today's date?", vbYesNo, "Gentle Reminder")
            Case vbYes
                Range("LastChangeDate").Value = Format(Now(), "m/d/yyyy")
            Case vbNo
        End Select
    End If
End Sub

Or, if the date should be updated when changes are saved on a new day, try this...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Not ThisWorkbook.Saved Then
        If Range("TheDate") < Format(Now(), "d/m/yyyy") Then
            Select Case MsgBox("Save changes and change to today's date?", vbYesNoCancel, "Gentle Reminder")
                Case vbCancel
                    Cancel = True
                Case vbYes
                    Range("TheDate").Value = Format(Now(), "m/d/yyyy")
                Case vbNo
            End Select
        End If
    Else
        Cancel = True
    End If
End Sub

Or, if you want to update the first time they make a change to any cell on any worksheet, try this...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Range("TheDate") < Format(Now(), "d/m/yyyy") Then
        Select Case MsgBox("Change to today's date?", vbYesNoCancel, "Gentle Reminder")
            Case vbCancel
                Cancel = True
            Case vbYes
                Range("TheDate").Value = Format(Now(), "d/m/yyyy")
            Case vbNo
        End Select
    End If
End Sub

Or, if you want them to be able to enter comments on a specific worksheet, but force the date change for any other worksheet, try this...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name <> "Manager Comments" Then
        If Range("TheDate") < Format(Now(), "d/m/yyyy") Then
            Select Case MsgBox("Change to today's date?", vbYesNoCancel, "Gentle Reminder")
                Case vbCancel
                    Cancel = True
                Case vbYes
                    Range("TheDate").Value = Format(Now(), "d/m/yyyy")
                Case vbNo
            End Select
        End If
    End If
End Sub

If you want them to be able to make changes on any worksheet except one, there are two options: using the Workbook_SheetChange event procedure or that worksheet's Change event procedure...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "Data Extract" Then
        If Range("TheDate") < Format(Now(), "d/m/yyyy") Then
            Select Case MsgBox("Change to today's date?", vbYesNoCancel, "Gentle Reminder")
                Case vbCancel
                    Cancel = True
                Case vbYes
                    Range("TheDate").Value = Format(Now(), "d/m/yyyy")
                Case vbNo
            End Select
        End If
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("TheDate") < Format(Now(), "d/m/yyyy") Then
        Select Case MsgBox("Change to today's date?", vbYesNoCancel, "Gentle Reminder")
            Case vbCancel
                Cancel = True
            Case vbYes
                Range("TheDate").Value = Format(Now(), "d/m/yyyy")
            Case vbNo
        End Select
    End If

End Sub


No comments:

Post a Comment