Hi Everyone,

I have a need support data entry of a time.  My client wants all times
entered to be rounded to the nearest 15 minutes. I thought it would be
useful to use the DateTimePicker control to do this since it allows
for 12 and 24 hr clock values and can format the output with or
without AM/PM indicators.  I was already using it on the form to input
some dates.

It seemed like a good idea at the time! <g>

I came across two basic problems with this control.
1. I want the control to display empty until a time is actually keyed
in.  This was quite hard to do and after much searching came across a
method that does this quite elegantly.  I post this solution here for
general information.
To display an empty value for a DateTimePicker control
Const Time_Null_Marker_Format="'"  'Note:That is two single quotes
within the two double quotes
    DTPicker1.Format = dtpCustom
    DTPicker1.CustomFormat = Time_Null_Marker_Format

Note this does not change the value of the control just the display.
Knowing this, I set the format to something else in the control's
Enter event so that if I want to know if the control hasn't yet been
edited I can test for DTPicker1.CustomFormat = Time_Null_Marker_Format

Now the problem I can's solve.
2. How to round the time entered to the nearest 15 minutes.
This is where I have noticed some strange (for me anyway) behaviour.

I thought it would be a simple matter of putting some code in the
BeforeUpdate, AfterUpdate or Exit event for the control. I have even
tried the Change event.

The problem is that the events do not behave in a way a can use.
Neither the BeforeUpdate or  AfterUpdate events seem to fire.
The Change event will fire as you change from parts of the control
(say from hour to minutes) but it doesn't do so immediately.   I can
understand this in the case of entering a single digit value (it
pauses briefly and unless another digit is entered it accepts the
single digit value) but is still seems to pause after the second
digit.
The Exit event fires if you click the UpDown arrows of the control.

Any insight into how to make this work would be appreciated.

Cheers
Happy Christmas and Other Festivities,

TonyS.

Do the following to produce a working form to see this in action.

Create a form.
To be able to create the control you need to display the VBA toolbox
and right click somewhere on the toolbox.  Select "Additional
Controls" from the context menu that is displayed.

Scroll through the Additional Controls list (make sure the Show
"Selected Items Only" checkbox is unchecked)
to bring up the "Microsoft Date Time Picker Control 6.0 (SP4)" (the
file this is is in is MSCOMCT2.OCX )
Select the Checkbox beside the listing.

Now Place a textbox (or any other control that can receive focus when
you exit the dtp) and one DateTimePicker control onto the form.

Paste the following code into the UserForm's general section then run
the form.
if you put breakpoints on the  BeforeUpdate or  AfterUpdate events you
can see that they don't fire.

Try changing the minutes by entering a value by keyboard.  You will
see that if you quickly tan out of the control, the value is not
rounded.

Also see the note in the Change event.

Private Sub DTPicker_AfterUpdate()
   DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub

Private Sub DTPicker_BeforeUpdate(ByVal Cancel As
MSForms.ReturnBoolean)
   DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub

Private Sub DTPicker_Change()
   'If this is enabled then you can't change the time using the
   'updown arrows because each change is rounded to nearest 15
   'interestingly you can change down which causes the hours to
decrement
   DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub

Private Sub DTPicker_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   DTPicker = CDate(RoundTimeTo(DTPicker, 15))
End Sub

Private Sub UserForm_Activate()
   With DTPicker
       .Format = dtpCustom
       .CustomFormat = "h:mm tt"
       .UpDown = True
   End With
End Sub

Function RoundTimeTo(TargetDateTime As String, RoundingInterval As
Integer) As String
   'Please ignore the clumsiness of this procedure.  I was tired and
it was late.!
   Dim CurrMinute

   Dim Num
   Dim hrs
   Dim difr
   Dim wrk
   Dim adjustment

       Dim remainder
   Dim TimeInMinutes
   Dim wrkDate As Date

   wrkDate = CDate(TargetDateTime)
   hrs = Hour(wrkDate)

   CurrMinute = Minute(CDate(TargetDateTime))
   TimeInMinutes = (hrs * 60) + CurrMinute

   remainder = TimeInMinutes Mod RoundingInterval

   If remainder < RoundingInterval / 2 Then
       adjustment = -remainder
   ElseIf remainder > RoundingInterval / 2 Then
       adjustment = RoundingInterval - remainder
   Else
       adjustment = 0
   End If

   wrk = (hrs * 60) + CurrMinute + adjustment
   Dim dt As Date

   dt = DateSerial(Year(TargetDateTime), Month(TargetDateTime),
Day(TargetDateTime))
   wrk = DateAdd("n", wrk, dt)

   RoundTimeTo = wrk
End Function