Numeric Value returned when Time format returned to User Form TextBox

[Denny57]

The following code uploads information as "hh:mm" format to cells in a worksheet which also have the same custom format.
However, when these details are recalled to the User Form they appear in numeric format.

I am hoping that there might be a simple solution that will both send and return these details in the required format.

Dim CurrentRow      As Long
Dim wsDailyHours    As Worksheet
Private Sub UserForm_Initialize()

    Set wsDailyHours = ThisWorkbook.Worksheets("Daily Hours Input")
  
    Call cmdClearForm_Click
         
End Sub

Private Sub cmdInputRecords_Click()
    Dim answer      As VbMsgBoxResult
    Dim AddRecord   As Boolean
  
    AddRecord = Val(Me.cmdInputRecords.Tag) = xlAdd
  
    answer = MsgBox(IIf(AddRecord, "Add New", "Update Current") & " Record?", 36, "Information")
    If answer = vbYes Then
      
        'new record
        If AddRecord Then CurrentRow = wsDailyHours.Range("A" & wsDailyHours.Rows.Count).End(xlUp).Row + 1
      
        On Error GoTo myerror
        With wsDailyHours
            .Cells(CurrentRow, 1).Value = DTPicker1.Value
            .Cells(CurrentRow, 2).Value = cboSchedulingType.Value
            .Cells(CurrentRow, 3).Value = cboLocation.Value
            '.Cells(CurrentRow, 5).Value = txtStartTime.Value
            '.Cells(CurrentRow, 6).Value = txtFinishTime.Value
            .Cells(CurrentRow, 5).Value = CDate(Format(txtStartTime.Text, "hh:mm"))
            .Cells(CurrentRow, 6).Value = CDate(Format(txtFinishTime.Text, "hh:mm"))
            .Cells(CurrentRow, 11).Value = cboPayRate.Value
            .Cells(CurrentRow, 13).Value = CheckBoxPete.Value
            .Cells(CurrentRow, 14).Value = CheckBoxKirsty.Value
            .Cells(CurrentRow, 15).Value = CheckBoxJan.Value
            .Cells(CurrentRow, 16).Value = CheckBoxKelly.Value
            .Cells(CurrentRow, 17).Value = CheckBoxCarla.Value
        End With
      
        MsgBox "Record has been " & IIf(AddRecord, "added", "updated") & " to the database", 64, "Information"
      
    End If
    
    'With ActiveSheet
    'Application.Goto Reference:=.Cells(.Rows.Count, "A").End(xlUp).Offset(-20), Scroll:=True
    'End With

    Call cmdClearForm_Click
    DTPicker1.SetFocus
  
myerror:
 If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Private Sub cmdDateSearch_Click()
    'Used to search for records for a specific date
    Dim rng             As Range
    Dim Res             As Variant, myFind As Variant
  
  
    Set rng = wsDailyHours.Range("A:A")
  
    myFind = Me.txtDateSearch.Value
  
    If Not IsDate(myFind) Then Exit Sub
  
    myFind = CDate(myFind)
  
    Res = Application.Match(CLng(myFind), rng, 0)
  
    If Not IsError(Res) Then
      
        CurrentRow = CLng(Res)
      
        With wsDailyHours
      
            DTPicker1.Value = .Cells(CurrentRow, 1)
            cboSchedulingType.Value = .Cells(CurrentRow, 2)
            cboLocation.Value = .Cells(CurrentRow, 3)
            txtStartTime.Text = .Cells(CurrentRow, 5)
            txtFinishTime.Text = .Cells(CurrentRow, 6)
            cboPayRate.Value = .Cells(CurrentRow, 11)
            CheckBoxPete.Value = .Cells(CurrentRow, 13)
            CheckBoxKirsty.Value = .Cells(CurrentRow, 14)
            CheckBoxJan.Value = .Cells(CurrentRow, 15)
            CheckBoxKelly.Value = .Cells(CurrentRow, 16)
            CheckBoxCarla.Value = .Cells(CurrentRow, 17)
            txtWorkDate.Value = .Cells(CurrentRow, 1).Value
            txtDailyPayMonth.Value = .Cells(CurrentRow, 4).Value
            txtDailyEarningsGross.Value = .Cells(CurrentRow, 12).Text
          
            If .Cells(CurrentRow, 2).Value = "Work" Then
                txtDailyWorkHours.Value = .Cells(CurrentRow, 10).Value
            ElseIf .Cells(CurrentRow, 2).Value = "Leave" Then
                txtDailyLeaveHours.Value = .Cells(CurrentRow, 10).Value
            ElseIf .Cells(CurrentRow, 2).Value = "Non-Working Day" Then
                txtDailyNonWorkingDay.Value = "Yes"
            End If
          
        End With
      
        'update submit commandbutton status
        With Me.cmdInputRecords
            .Tag = xlUpdateState
            .Caption = "Update"
            .BackColor = rgbDarkGreen
        End With
      
    Else
      
        MsgBox "Date Not Found", vbInformation, "Date Not Found"
      
    End If
  
End Sub
Private Sub cboPayRate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim payrate As Double
    payrate = cboPayRate.Value
    cboPayRate.Value = Format(cboPayRate.Value, "Currency")
End Sub
Private Sub cmdClearForm_Click()
'Clears the User Form
    DTPicker1.Value = Date
    cboSchedulingType.Value = ""
    cboLocation.Value = ""
    txtStartTime.Value = "00:00"
    txtStartTime.MaxLength = 5
    txtFinishTime.Value = "00:00"
    txtFinishTime.MaxLength = 5
    cboPayRate.Value = ""
    CheckBoxPete.Value = False
    CheckBoxKirsty.Value = False
    CheckBoxJan.Value = False
    CheckBoxKelly.Value = False
    CheckBoxCarla.Value = False
    txtWorkDate.Value = ""
    txtDailyPayMonth.Value = ""
    txtDailyWorkHours.Value = ""
    txtDailyLeaveHours.Value = ""
    txtDailyNonWorkingDay.Value = ""
    txtDailyEarningsGross.Value = ""
    txtMonthlyWorkHours.Value = ""
    txtDailyEarningsGross.Value = ""
    txtMonthlyPayMonth.Value = ""
    txtMonthlyWorkHours.Value = ""
    txtMonthlyWorkEarningsGross.Value = ""
    txtMonthlyLeaveHours.Value = ""
    txtMonthlyLeaveEarningsGross.Value = ""
    txtTotalMonthlyEarningsGross.Value = ""
    txtDateSearch.Value = ""
    cboPayMonthSearch.Value = ""
  
    DTPicker1.SetFocus
  
    With Me.cmdInputRecords
        .Tag = xlAdd
        .Caption = "Add Record"
        .BackColor = rgbBlue
    End With
End Sub
Private Sub cmdCloseForm_Click()
'Closes the User Form
    Unload Me
End Sub
Private Sub txtStartTime_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If IsDate(txtStartTime.Value) And Len(txtStartTime.Text) = 5 Then
    Else
        MsgBox "Input Start Time as for example 09:15"
        txtStartTime.Text = ""
    End If
End Sub

Private Sub txtEndTime_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If IsDate(txtEndTime.Value) And Len(txtEndTime.Text) = 5 Then
    Else
        MsgBox "Input End Time as for example 09:15"
        txtEndTime.Text = ""
    End If
End Sub
Private Sub txtDateSearch_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   Cancel = InValidDate(Me.txtDateSearch)
End Sub

'common function
Function InValidDate(ByVal Box As Object) As Boolean
    Const DateFormat As String = "dd/mm/yyyy"
    With Box
        If Len(.Value) > 0 Then
            If IsDate(.Value) Then
                'format textbox date
                .Value = Format(CDate(.Value), DateFormat)
             Else
                InValidDate = True
            End If
        End If
    End With
    If InValidDate Then MsgBox "Invalid Date Entry", 48, "Invalid Date"
End Function
Private Sub cmdPayMonthSearch_Click()

txtMonthlyPayMonth.Value = cboPayMonthSearch.Value
txtMonthlyWorkHours = Format(WorksheetFunction.SumIfs(Columns("J"), Columns("B"), "Work", Columns("D"), cboPayMonthSearch.Value), "#,##0.00")
txtMonthlyWorkEarningsGross = Format(WorksheetFunction.SumIfs(Columns("L"), Columns("B"), "Work", Columns("D"), cboPayMonthSearch.Value), "£#,##0.00")
txtMonthlyLeaveHours = Format(WorksheetFunction.SumIfs(Columns("J"), Columns("B"), "Leave", Columns("D"), cboPayMonthSearch.Value), "#,##0.00")
txtMonthlyLeaveEarningsGross = Format(WorksheetFunction.SumIfs(Columns("L"), Columns("B"), "Leave", Columns("D"), cboPayMonthSearch.Value), "£#,##0.00")

Dim x As Double, y As Double
    x = txtMonthlyWorkEarningsGross.Value
    y = txtMonthlyLeaveEarningsGross.Value

    
    txtTotalMonthlyEarningsGross.Value = Format(x + y, "Currency")
    
End Sub

Thank You In Advance

 

[6StringJazzer]

You were not specific about which lines of code populate the textboxes with times. But here is a general answer.

Excel stores date and time data as a real number in units of days. What you see as hh:mm in the cell is a result of the setting for the display format of the cell. The underlying data is still a number. When you copy that data to a textbox, you are grabbing the underlying number.

To display it in the text box you must also format it first. Because you have it displayed as desired in the already, you can take advantage of that. Modify existing code to reference the Text property of the cell, which will retrieve a text version of what is being displayed.

            txtStartTime.Text = .Cells(CurrentRow, 5).Text

For other cases if you want the textbox to show the data in a different format than what's in the cell, that could also be done easily but I'm not going to clog things up with that since your question seems pretty specific.

 

[Denny57]

Excellent, Thank you. Works brilliantly

 

[6StringJazzer]

Glad to help!