Time in Textbox and Listbox

[mucah!t]

Hello all,

I'd like to use a textbox to enter time on a userform.
The textbox is linked to a listbox.

The textboxes will show the data of the selected record from the listbox.
The problem is that the listbox and the textbox show time as 0.27708 etc iso 23:37 etc.

The follwing code will show the time correctly in the textbox:

TextBox6.Value = Format(TextBox6.Value, "hh:mm")

But this code makes it impossible to enter a time correctly.
I am also still looking for a way to display time in the listbox correctly.

Any ideas?

 

[mucah!t]

All help is welcome

 

[Norie]

How are you populating the listbox and textbox?

Also, on the worksheet is the data formatted as you want it displayed in the listbox?

 

[mucah!t]

Hello Norie,

This is the code.
The cells are formated in the right way

Dim MyData     As Range
Dim c          As Range
Dim rFound     As Range
Dim R          As Long
Dim rng        As Range
Const frmMax   As Long = 320
Const frmHt    As Long = 210
Const frmWidth As Long = 300
Dim sFileName  As String        'image name
Dim oCtrl      As MSForms.Control
Private Sub cmbAdd_Click()
    'next empty cell in column A
    Set c = Sheets("Database").Range("A65536").End(xlUp).Offset(1, 0)
 
    Application.ScreenUpdating = False
 
    With Me
        c.FormulaR1C1 = .TextBox1.Value
        c.Offset(0, 1).Value = .TextBox2.Value
        c.Offset(0, 2).Value = .TextBox3.Value
        c.Offset(0, 3).Value = .TextBox4.Value
        c.Offset(0, 4).Value = .DTPicker1.Value
        c.Offset(0, 5).Value = .TextBox6.Value
        c.Offset(0, 6).Value = .DTPicker2.Value
        c.Offset(0, 7).Value = .TextBox8.Value
        'c.Offset(0, 5).FormulaR1C1 = "=IF(COUNTIF(R2C[-3]:R993C[-3],RC[-3])>1,""Yes"","""")"
        'clear the form
        ClearControls
    End With
    UserForm_Initialize
    Application.ScreenUpdating = True
End Sub
Private Sub cmbDelete_Click()
Application.ScreenUpdating = False
    'Delete record
    '===============
    Dim I As Long
    With Me.ListBox1
        For I = .ListCount - 1 To 0 Step -1
            If .Selected(I) Then Sheets("Database").Rows(I + 1).EntireRow.Delete
        Next I
    End With
    '===============
   UserForm_Initialize
   Application.ScreenUpdating = True
End Sub
Private Sub cmbAmend_Click()
   Dim rw As Long
   Dim I As Long
 
   Application.ScreenUpdating = False
 
   With Me.ListBox1
      For I = .ListCount - 1 To 0 Step -1
         If .Selected(I) Then
           'Update record
           '===============
            rw = Sheets("Database").Rows(I + 1).Row
            With Sheets("Database")
 
               .Range("A" & rw).Value = TextBox1.Value
               .Range("B" & rw).Value = TextBox2.Value
               .Range("C" & rw).Value = TextBox3.Value
               .Range("D" & rw).Value = TextBox4.Value
               .Range("E" & rw).Value = DTPicker1.Value
               .Range("F" & rw).Value = TextBox6.Value
               .Range("G" & rw).Value = DTPicker2.Value
               .Range("H" & rw).Value = TextBox8.Value
 
            End With
            Exit For
            '===============
         End If
      Next I
   End With
 
   UserForm_Initialize
   Application.ScreenUpdating = True
End Sub
 
Private Sub cmbLast_Click()
'Select last Populated Cell
'===============
'Cells(65536, 1).End(xlUp).Select
'===============
ListBox1.ListIndex = ListBox1.ListCount - 1
    Dim LastCl As Range
    Set LastCl = Sheets("Database").Range("a65536").End(xlUp)
 
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = LastCl.Offset(0, 0).Value
        .TextBox2.Value = LastCl.Offset(0, 1).Value
        .TextBox3.Value = LastCl.Offset(0, 2).Value
        .TextBox4.Value = LastCl.Offset(0, 3).Value
        .DTPicker1.Value = LastCl.Offset(0, 4).Value
        .TextBox6.Value = LastCl.Offset(0, 5).Value
        .DTPicker2.Value = LastCl.Offset(0, 6).Value
        .TextBox8.Value = LastCl.Offset(0, 7).Value
        sFileName = LastCl.Offset(0, 4).Value
    End With
End Sub
 
Private Sub cmnbFirst_Click()
'Select first Populated Cell
'===============
'Cells(1, 1).End(xlUp).Select
'===============
ListBox1.ListIndex = 1
    Dim FirstCl As Range
    'first data Entry
   Set FirstCl = IIf(Sheets("Database").Range("A1").Value = "", Sheets("Database").Range("A1").End(xlDown), Sheets("Database").Range("A2"))
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = FirstCl.Offset(0, 0).Value
        .TextBox2.Value = FirstCl.Offset(0, 1).Value
        .TextBox3.Value = FirstCl.Offset(0, 2).Value
        .TextBox4.Value = FirstCl.Offset(0, 3).Value
        .DTPicker1.Value = FirstCl.Offset(0, 4).Value
        .TextBox6.Value = FirstCl.Offset(0, 5).Value
        .DTPicker2.Value = FirstCl.Offset(0, 6).Value
        .TextBox8.Value = FirstCl.Offset(0, 7).Value
    End With
End Sub
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Sheets("Database").Cells.Sort Key1:=Sheets("Database").Range("A1"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
       UserForm_Initialize
End Sub
 
Private Sub CommandButton3_Click()
'Fill Range Between two Number
'=============================
Dim vStop, vStart
    With WorksheetFunction
        vStart = 1
        vStop = WorksheetFunction.CountA(Worksheets("Database").Range("C2:C1000"))
    End With
 
    With Sheet2
        .Range("B2") = vStart
        .Range("A6:A1000").DataSeries Step:=1, Stop:=vStop
            End With
'=============================
       UserForm_Initialize
End Sub
 
Private Sub ListBox1_Click()
    If Me.ListBox1.ListIndex = -1 Then    'not selected
        MsgBox " No selection made"
    ElseIf Me.ListBox1.ListIndex >= 1 Then    'User has selected
        R = Me.ListBox1.ListIndex
        With Me
            .TextBox1.Value = ListBox1.List(R, 0)
            .TextBox2.Value = ListBox1.List(R, 1)
            .TextBox3.Value = ListBox1.List(R, 2)
            .TextBox4.Value = ListBox1.List(R, 3)
            .DTPicker1.Value = ListBox1.List(R, 4)
            .TextBox6.Value = ListBox1.List(R, 5)
            .DTPicker2.Value = ListBox1.List(R, 6)
            .TextBox8.Value = ListBox1.List(R, 7)
            .cmbAmend.Enabled = True      'allow amendment or
            .cmbDelete.Enabled = True     'allow record deletion
            .cmbAdd.Enabled = False       'don't want duplicate
        End With
    End If
End Sub
Private Sub TextBox6_Change()
    TextBox6.Value = Format(TextBox6.Value, "hh:mm")
End Sub
Private Sub UserForm_Initialize()
 
    Dim lbtarget As MSForms.ListBox
    Dim rngSource As Range
 
    'Set reference to the range of data to be filled
    Set rngSource = Sheets("Database").Range("A1", Sheets("Database").Range("J1").End(xlDown))
 
    'Fill the listbox
    Set lbtarget = Me.ListBox1
    With lbtarget
        'Determine number of columns
        .ColumnCount = 8
        'Set column widths
        .ColumnWidths = "100;70;30;30;50,50,50,50,100,0"
        'Insert the range of data supplied
        .List = rngSource.Cells.Value
    End With
 
    ListBox1.ListIndex = 0 'Select first row on listbox
 
 
End Sub
 
Sub ClearControls()
    With Me
        For Each oCtrl In .Controls
            Select Case TypeName(oCtrl)
                Case "TextBox": oCtrl.Value = Empty
                Case "OptionButton": oCtrl.Value = False
            End Select
        Next oCtrl
    End With
End Sub

 

[Norie]

Where/when exactly is the error occuring?

Also which column(s) is it that's causing the problem?

I'm guessing column F, any others?

One thing you could try is using a different method to populate the listbox and using the Text property to get the data as it's shown on the worksheet.

That would probably require a loop, something like this perhaps:

        For I = 1 To rngSource.Rows.Count
            
            .AddItem rngSource.Cells(I, 1).Text
            
            For col = 2 To rngSource.Columns.Count
                .List(I - 1, col - 1) = rngSource.Cells(I, col).Text
            Next col
            
        Next I

PS Why is the column count of the listbox 8 when the range is 10 columns wide?