Excel 365 VBA for hours and minutes format - excel

Question

I'm working on a simple Excel file with some worksheets where in every one I've report hours and minutes of work. I want to show it like 313:32 that is 313 hours and 32 minutes, to do that I'm using a custom format [h]:mm
To facilitate the workers that use Excel very little, I have thought to create some vba code, so that they could insert also not only the minutes, besides the classical format [h]:mm, so they can also insert value in hours and minutes.
I report some example data that I want to have.
What I insert -> what I want that are printed inside the cell
1 -> 0:01
2 -> 0:02
3 -> 0:03
65 -> 1:05
23:33 -> 23:33
24:00 -> 24:00
24:01 -> 24:01
Then I formatted every cell that can contain a time value in [h]:mm and I wrote this code
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo bm_Safe_Exit
With Sh
If IsNumeric(Target) = True And Target.NumberFormat = "[h]:mm" Then
If Int(Target.Value) / Target.Value = 1 Then
Debug.Print "Integer -> " & Target.Value
Application.EnableEvents = False
Target.Value = Target.Value / 1440
Application.EnableEvents = True
Exit Sub
End If
Debug.Print "Other value -> " & Target.Value
End If
End With
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
The code works well enough, but it errs when I enter 24:00 and its multiples, 48:00, 72:00 ...
This because the cell are formatted [h]:mm so 24:00 became 1 before the vba code execution!
I tried to correct the code, and the funny fact is that when I correct the 24:00, so 24:00 remain 24:00 and not 00:24, the problem switch to 1 that became 24:00 instead 00:01
My first idea was to "force" the vba code execution before the cell format, but I don't know if it is possible.
I know that seems a stupid question, but I really don't know if it is possible and how to fix it.
Any idea will be much appreciated

Answer 1

Requirements: Time is to be reported in Hours and Minutes, minutes is the lowest measure ( i.e.: whatever the amount of time is to be reported in hours and the partial hours in minutes, i.e. 13 days, 1 hour and 32 minutes or 13.0638888888888889 shall be shown as 313:32 )
Users should be allowed to enter time in two different manners:
To enter only minutes: The value entered shall be a whole number (no decimals).
To enter hours and minutes: The value entered shall be composed by two whole numbers representing the hours and the minutes separated a colon :.
Excel Processing Values Entered:
Excel intuitively process the Data type and Number.Format of the values entered in cells.
When the Cell NumberFormat is General, Excel converts the values entered to the data type in relation with the data entered (String, Double, Currency, Date, etc. ), it also changes the NumberFormat as per the “format” entered with the value (see table below).
When the Cell NumberFormat is other than General, Excel converts the values entered to the data type corresponding to the format of the cell, with no changes to the NumberFormat (see table below).
Therefore, it's not possible to know the format of the values as entered by the user, unless the values entered can be can intercepted before Excel applies its processing methods.
Although the values entered cannot be intercepted before Excel process them, we can set a validation criteria for the values entered by the users using the Range.Validation property.
Solution: This proposed solution uses:
Workbook.Styles property (Excel): To identify and format the Input cells.
Range.Validation property (Excel): To communicate the users the format required for the values entered, enforcing them to enter the data as text.
Workbook_SheetChange workbook event: To validate and process the values entered.
It's suggested to use a customized style to identify and format the input cells, actually OP is using the NumberFormat to identify the input cells, however it seems that there could also be cells with formulas, or objects (i.e. Summary Tables, PivotTables, etc.) that require the same NumberFormat. By using the customized style only for the input cells, the non-input cells can be easily excluded from the process.
The Style object (Excel) allows to set the NumberFormat, Font, Alignment, Borders, Interior and Protection at once for a single or multiple cells. The procedure below adds a customized Style named TimeInput. The name of the Style is defined as a public constant because it will be used across the workbook.
Add this into an standard module
Public Const pk_StyTmInp As String = "TimeInput"
Private Sub Wbk_Styles_Add_TimeInput()
With ActiveWorkbook.Styles.Add(pk_StyTmInp)
.IncludeNumber = True
.IncludeFont = True
.IncludeAlignment = True
.IncludeBorder = True
.IncludePatterns = True
.IncludeProtection = True
.NumberFormat = "[h]:mm"
.Font.Color = XlRgbColor.rgbBlue
.HorizontalAlignment = xlGeneral
.Borders.LineStyle = xlNone
.Interior.Color = XlRgbColor.rgbPowderBlue
.Locked = False
.FormulaHidden = False
End With
End Sub
The new Style will show in the Home tab, just select the input range and apply the Style.
We’ll use the Validation object (Excel) to tell users the criteria for the time values and to force them to enter the values as Text.
The following procedure sets the style of the Input range and adds a validation to each cell:
Private Sub InputRange_Set_Properties(Rng As Range)
Const kFml As String = "=ISTEXT(#CLL)"
Const kTtl As String = "Time as ['M] or ['H:M]"
Const kMsg As String = "Enter time preceded by a apostrophe [']" & vbLf & _
"enter M minutes as 'M" & vbLf & _
"or H hours and M minutes as 'H:M" 'Change as required
Dim sFml As String
Application.EnableEvents = False
With Rng
.Style = pk_StyTmInp
sFml = Replace(kFml, "#CLL", .Cells(1).Address(0, 0))
With .Validation
.Delete
.Add Type:=xlValidateCustom, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=sFml
.IgnoreBlank = True
.InCellDropdown = False
.InputTitle = kTtl
.InputMessage = kMsg
.ShowInput = True
.ErrorTitle = kTtl
.ErrorMessage = kMsg
.ShowError = True
End With: End With
Application.EnableEvents = True
End Sub
The procedure can be called like this
Private Sub InputRange_Set_Properties_TEST()
Dim Rng As Range
Set Rng = ThisWorkbook.Sheets("TEST").Range("D3:D31")
Call InputRange_Set_Properties(Rng)
End Sub
Now that we have set the input range with the appropriated style and validation, let’s write the Workbook Event that will process the Time inputs:
Copy these procedures in ThisWorkbook module:
Workbook_SheetChange - Workbook event
InputTime_ƒAsDate - Support function
InputTime_ƒAsMinutes - Support function
…
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const kMsg As String = "[ #INP ] is not a valid entry."
Dim blValid As Boolean
Dim vInput As Variant, dOutput As Date
Dim iTime As Integer
Application.EnableEvents = False
With Target
Rem Validate Input Cell
If .Cells.Count > 1 Then GoTo EXIT_Pcdr 'Target has multiple cells
If .Style <> pk_StyTmInp Then GoTo EXIT_Pcdr 'Target Style is not TimeInput
If .Value = vbNullString Then GoTo EXIT_Pcdr 'Target is empty
Rem Validate & Process Input Value
vInput = .Value 'Set Input Value
Select Case True
Case Application.IsNumber(vInput): GoTo EXIT_Pcdr 'NO ACTION NEEDED - Cell value is not a text thus is not an user input
Case InStr(vInput, ":") > 0: blValid = InputTime_ƒAsDate(dOutput, vInput) 'Validate & Format as Date
Case Else: blValid = InputTime_ƒAsMinutes(dOutput, vInput) 'Validate & Format as Minutes
End Select
Rem Enter Output
If blValid Then
Rem Validation was OK
.Value = dOutput
Else
Rem Validation failed
MsgBox Replace(kMsg, "#INP", vInput), vbInformation, "Input Time"
.Value = vbNullString
GoTo EXIT_Pcdr
End If
End With
EXIT_Pcdr:
Application.EnableEvents = True
End Sub
…
Private Function InputTime_ƒAsDate(dOutput As Date, vInput As Variant) As Boolean
Dim vTime As Variant, dTime As Date
Rem Output Initialize
dOutput = 0
Rem Validate & Process Input Value as Date
vTime = Split(vInput, ":")
Select Case UBound(vTime)
Case 1
On Error Resume Next
dTime = TimeSerial(CInt(vTime(0)), CInt(vTime(1)), 0) 'Convert Input to Date
On Error GoTo 0
If dTime = 0 Then Exit Function 'Input is Invalid
dOutput = dTime 'Input is Ok
Case Else: Exit Function 'Input is Invalid
End Select
InputTime_ƒAsDate = True
End Function
…
Private Function InputTime_ƒAsMinutes(dOutput As Date, vInput As Variant) As Boolean
Dim iTime As Integer, dTime As Date
Rem Output Initialize
dOutput = 0
Rem Validate & Process Input Value as Integer
On Error Resume Next
iTime = vInput
On Error GoTo 0
Select Case iTime = vInput
Case True
On Error Resume Next
dTime = TimeSerial(0, vInput, 0) 'Convert Input to Date
On Error GoTo 0
If dTime = 0 Then Exit Function 'Input is Invalid
dOutput = dTime 'Input is Ok
Case Else: Exit Function 'Input is Invalid
End Select
InputTime_ƒAsMinutes = True
End Function
The table below shows the output for various types of values entered.

Answer 2

The simplest way appears to be to use the cell text (i.e. how the cell is displayed) in preference to the actual cell value. If it looks like a time (e.g. "[h]:mm", "hh:mm", "hh:mm:ss") then use that to add the value of each time part accordingly (to avoid the 24:00 issue). Otherwise, if it's a number, assume that to be minutes.
The below method also works for formats like General, Text and Time (unless the time begins with a days part, but it could be further developed to deal with that too where necessary).
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Dim part As String, parts() As String, total As Single
Application.EnableEvents = False
If Not IsEmpty(Target) And Target.NumberFormat = "[h]:mm" Then
'prefer how the Target looks over its underlying value
If InStr(Target.Text, ":") Then
'split by ":" then add the parts to give the decimal value
parts = Split(Target.Text, ":")
total = 0
'hours
If IsNumeric(parts(0)) Then
total = CInt(parts(0)) / 24
End If
'minutes
If 0 < UBound(parts) Then
If IsNumeric(parts(1)) Then
total = total + CInt(parts(1)) / 1440
End If
End If
ElseIf IsNumeric(Target.Value) Then
'if it doesn't look like a time format but is numeric, count as minutes
total = Target.Value / 1440
End If
Target.Value = total
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub