Excel macro to return Current Time in multiples of 5 minutes

[panditji]

Hi friends,

I am looking for a function in Excel VBA to return current time (system time) into a specific cell but the return cell should be in higher rounding off multiple of 5 minutes.

E.g

If current time is 16:04:14 then I need return of 16:05:00
If current time is 12:12:06 then I need return of 12:15:00
If current time is 09:57:59 then I need return of 10:00:00

TIA

Regards

[xLJer]

Here is one way to round up the system time
to the nearest 5 minutes.

Private Sub Time_Test()
Dim sTime As String, newTime As String

    sTime = Format(Now(), "HH:MM:SS")
    newTime = Calc_NewTime(sTime)
    
    MsgBox "System time: " & sTime & vbCrLf & _
        "Minutes rounded up: " & newTime
    
End Sub

Function Calc_NewTime(inText As String) As String
'round up minutes to the nearest 5 minutes.
'return time in text string formatted as HH:MM:SS
Dim intMinutes As Integer, intSeconds As Integer
Dim timeText As String

    intMinutes = CInt(Mid(inText, 4, 2))
    intSeconds = CInt(Mid(inText, 7, 2))
    
    If intMinutes Mod 5 <> 0 Or intSeconds <> 0 Then
        intMinutes = intMinutes + (5 - (intMinutes Mod 5))
    End If
    
    timeText = Mid(inText, 1, 3) & Right("0" & CStr(intMinutes), 2) & ":00"

    Calc_NewTime = timeText

End Function

[tigeravatar]

panditji,

Does it have to be a macro? A native Excel formula will do the same thing rather easily, format the cell as h:mm:ss

=CEILING(NOW(),5/1440)

However, if it must be a macro, here's a macro version of the formula:

Sub tgr()
    
    With Sheets("Sheet1").Range("A1")
        .Value = Evaluate("CEILING(NOW(),5/1440)")
        .NumberFormat = "h:mm:ss"
    End With

End Sub