Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim inputRange As Range
Dim Start_Time As Range
Dim End_Time As Range
Dim Total_Time As Range
Dim time_difference As Double
' Set the ranges
Set inputRange = Range("C9:N16")
Set Start_Time = Range("B2")
Set End_Time = Range("B3")
Set Total_Time = Range("B4")
' Check for intersection and non-blank value
If Not Application.Intersect(Target, inputRange) Is Nothing And Target.Cells.Count = 1 And Target.Cells(1, 1).Value <> "" Then
If IsEmpty(Start_Time.Value) Then
Start_Time.Value = RoundTo15Minutes(Now())
End_Time.ClearContents
Total_Time.ClearContents
Else
End_Time.Value = RoundTo15Minutes(Now())
End If
If Not IsEmpty(End_Time.Value) And Not IsEmpty(Start_Time.Value) Then
time_difference = End_Time.Value - Start_Time.Value
Total_Time.Value = ConvertToHours(time_difference)
End If
End If
End Sub
Sub Clear_Time()
Range("B2:B4").ClearContents
End Sub
Function RoundTo15Minutes(ByVal inputDateTime As Date) As Date
Dim roundedDateTime As Date
Dim hours As Integer
Dim minutes As Integer
' Extract the time components
hours = Hour(inputDateTime)
minutes = Minute(inputDateTime)
' Round to the nearest 15 minutes
minutes = Round(minutes / 15) * 15
' Handle the case where rounding goes to the next hour or day
If minutes = 60 Then
hours = hours + 1
minutes = 0
End If
' Handle the case where rounding goes to the next day
If hours = 24 Then
hours = 0
' Increment the date by 1 day
inputDateTime = inputDateTime + 1
End If
' Construct the rounded date and time using TimeSerial and DateSerial
roundedDateTime = TimeSerial(hours, minutes, 0) + DateSerial(Year(inputDateTime), Month(inputDateTime), Day(inputDateTime))
' Return the rounded date and time
RoundTo15Minutes = roundedDateTime
End Function
Function ConvertToHours(ByVal inputTime As Date) As Double
Dim hours As Double
' Extract the hour and minute components
Dim hourComponent As Integer
Dim minuteComponent As Integer
hourComponent = Hour(inputTime)
minuteComponent = Minute(inputTime)
' Convert to hours and round off to the nearest hour
hours = hourComponent + minuteComponent / 60
hours = Round(hours)
' Return the result
ConvertToHours = hours
End Function
