How to round time to the nearest quarter hour in word - vba

Question

I need to round time to the nearest quarter hour in a word document. I am not very good at coding.
After a fair bit of searching I have found some vba code but it doesn't quite work. The code is:
Sub Time()
Dim num() As String
Dim tod() As String
Dim temp As String
num = Split(Time, ":")
tod = Split(num(2), " ")
If Val(num(1)) < 15 Then
temp = "00"
ElseIf Val(num(1)) < 30 Then
temp = "15"
ElseIf Val(num(1)) < 45 Then
temp = "30"
ElseIf Val(num(1)) < 60 Then
temp = "45"
End If
gettime = num(0) + ":" + temp + ":00 " + tod(1)
End Function
End Sub
When I try to run it I get a message:
"Compile Error: Expected function or variable"
and "Time" on the fifth line of the code is highlighted which I think is where the program stops running.
The rest of the code in the form is as follows:
This module doesn't affect the time rounding issue but I am including it so as not to leave anything out.
Option Explicit
Sub ClusterCheck()
Dim i As Integer, k As Integer, iCluster As Integer, bResult As Boolean
Dim sFieldNameNo As String, sName As String
On Error Resume Next ' If the first formfield is a checkbox, this will bypass the error that Word returns
sName = Selection.FormFields(1).Name ' Get the name of the formfield
bResult = ActiveDocument.FormFields(sName).CheckBox.Value ' Get the result of the current formfield
sFieldNameNo = Number(sName) ' Get generic number
sName = Left(sName, Len(sName) - Len(sFieldNameNo)) ' Get generic name
' Determine how many fields are within the cluster group
iCluster = 1
Do Until ActiveDocument.Bookmarks.Exists(sName & iCluster) = False
iCluster = iCluster + 1
Loop
iCluster = iCluster - 1
' If the check field is true, turn all of the other check fields to false
Application.ScreenUpdating = False
If bResult = True Then
For k = 1 To iCluster
If k <> sFieldNameNo Then ActiveDocument.FormFields(sName & k).Result = False
Next
End If
Application.ScreenUpdating = True
End Sub
This is the Number module:
Option Explicit
Function Number(ByVal sNumber As String) As String
' This module finds the form fields number within the field name
' Loops through the field name until it only has the number
Do Until IsNumeric(sNumber) = True Or sNumber = ""
sNumber = Right(sNumber, Len(sNumber) - 1)
Loop
Number = sNumber
End Function
This is the protection module:
Option Explicit
Sub Protect()
ActiveDocument.Protect Password:="wup13", NoReset:=True, Type:=wdAllowOnlyFormFields
End Sub
Sub Unprotect()
ActiveDocument.Unprotect Password:="wup13"
End Sub
This is the code that activates on opening and closing the document:
Option Explicit
Sub Document_Open()
' Zooms to page width, turns on Hidden Text, and turns off ShowAll and Table Gridlines
With ActiveWindow.View
.Zoom.PageFit = wdPageFitBestFit
.ShowHiddenText = True
.TableGridlines = False
.ShowAll = False
End With
Options.UpdateFieldsAtPrint = False
End Sub
Sub Document_Close()
' Turn on ShowAll and Table Gridlines
With ActiveWindow.View
.ShowAll = True
.TableGridlines = True
End With
Options.UpdateFieldsAtPrint = True
End Sub
That's all the code in the form. I am not great at VBA but am hoping I can solve this issue (with a little help).
DETAILS OF EXTRA DUTY FORM
Persons details
Family name:
Given name(s):
Level:
No.:
Location:
Cost Centre Code:
Time worked
Were any days of the extra duty performed on a designated public/show holiday? Yes 0 No 0
If yes enter holiday date/details:
Time commenced: [Text Form Field]
Date:
Time ceased: [Text Form Field]
Date:
Total Overtime claimed:
Are you a shift worker? Yes 0 No 0
Details of extra duty performed:
Vehicle details
Car: Yes 0 No 0
Motorcycle: Yes 0 No 0
Registration no.:
Fleet no.:
Stationary vehicle hours:
Yes 0 No 0 (only use for stationary duties)
Vehicle odometer start:
Odometer finish:
Total kms:
Client’s details
Company/Organisation name:
Phone no.:
Contact name:
Job no.:
Payment for special services
Was payment received in advance? Yes 0 No 0
If Yes– Amount:
Receipt no.:
Date:
If No– Amount:
Invoice no.:
Date:
I, , certify the above information to be true
(Signature) (Date)
Manager certification (Checked with roster and certified correct)
(Signature) (Date)

Answer 1

The code from vbforums gives me a subscript out of range error when used as recommended.
In the VBA IDE you can get explanations of what keywords do by placing the cursor on a keyword and pressing F1. This will bring up the MS help page for that particular keyword.
In the OP code the main procedure is 'Time'. This will cause problems for VBA because this is the same as the Time keyword so we would effectively be saying
time(time)
and VBA will stop with an error because the second use of time will be interpreted as the sub time and not the VBA time function so you will get the error message 'Argument not optional'.
The code below will provide what the OP has requested.
Option Explicit
Sub test_gettime()
Dim myTime As String
myTime = Now()
Debug.Print myTime
Debug.Print Format(myTime, "hh:mm:ss")
Debug.Print gettime(Format(myTime, "hh:mm:ss"))
' without the format statement we should also get the date
myTime = Now()
Debug.Print
Debug.Print myTime
Debug.Print gettime(myTime)
End Sub
Public Function gettime(this_time As String) As String
Dim myTimeArray() As String
Dim myQuarterHour As String
myTimeArray = Split(this_time, ":")
' Note that myTimeArray has not been converted to numbers
' Comparison of strings works by comparing the ascii values of each character
' in turn until the requested logic is satisfied
Select Case myTimeArray(1)
Case Is < "15"
myQuarterHour = "00"
Case Is < "30"
myQuarterHour = "15"
Case Is < "45"
myQuarterHour = "30"
Case Is < "60"
myQuarterHour = "45"
Case Else
Debug.Print "More than 60 minutes in the hour??"
End Select
gettime = myTimeArray(0) + ":" + myQuarterHour + ":00 "
End Function