Excel 365 VBA for hours and minutes format

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:

1. To enter only minutes: The value entered shall be a whole number (no decimals).
2. 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