round time DOWN to nearest 15 mins

Option Explicit

Private Sub Command1_Click()
    Debug.Print fRoundTime15(#1:59:59 PM#)
End Sub

Public Function fRoundTime15(dtTime As Date) As Date
    Dim intHour As Integer
    Dim intMin As Integer
    Dim i As Integer
   
    intHour = Hour(dtTime)
    intMin = Minute(dtTime)
    For i = 0 To 60 Step 15
        If i > intMin Then
            intMin = i - 15
            Exit For
        End If
    Next i
    fRoundTime15 = TimeSerial(intHour, intMin, 0)
End Function

Public Function RoundToNearest15Min(dtTime As Date) As Date
   Dim intHour As Integer
   Dim intMin As Integer
   Dim i As Integer
   
   intHour = Hour(dtTime)
   intMin = Minute(dtTime)
   
   memdiff = 61
   For i = 0 To 60 Step 15
     'Use Abs() function to get the nearest
      If Abs(intMin - (i)) < memdiff Then
       memdiff = Abs(intMin - (i)): RoundedMin = i
      End If
   Next i
   RoundToNearest15Min = TimeSerial(intHour, RoundedMin, 0)
End Function

Private Sub Command1_Click()
 
Dim dtTime As Date
 
dtTime = #1:46:59 PM#
Debug.Print RoundToNearest15Min(dtTime)

dtTime = #1:58:59 PM#
Debug.Print RoundToNearest15Min(dtTime)

End Sub

Private Function RoundTime(ByVal dtTime As Date) As Date
    Dim lMins As Long
    Dim lSecs As Long
   
    lMins = CLng(Format(dtTime, "nn")) Mod 15
    lSecs = CLng(Format(dtTime, "ss"))
    dtTime = DateAdd("n", -lMins, dtTime)
    RoundTime = DateAdd("s", -lSecs, dtTime)
End Function

cheers mate !!

Nice solution.