How to fix formats for the Listbox view in a userform?

M

Mayozero

New Member
Joined
May 16, 2021
Messages
18
Office Version
  1. 2016
Platform
  1. Windows
Greetings,
i have created a userform and the database successfully but i have a problem i can't fix it.
my user form for my daily attendance in the compny like time in and time out to calculate my overtime and delay time for the whole month
my question is how to change the time format from the 0.00000 to HH:MM for D:J and the date for B same like in the sheet ?

Thanks alot in advance
Untitled2223.jpg


here is my code:
VBA Code: 
Option Explicit

Function copy_from_form_without_repeat()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Database").Activate
Set rng1 = Sheets("Database").Range("A:A").Find(str_search, , xlValues, xlWhole)
If rng1 Is Nothing Then
Dim lastrow As Long
lastrow = ActiveWorkbook.Sheets("Database").Range("A1000000").End(xlUp).Row
lastrow = lastrow + 1
With ActiveWorkbook.Sheets("Database")
.Range("A" & lastrow).Value = TextBox1.Value
.Range("B" & lastrow).Value = TextBox2.Value
.Range("C" & lastrow).Value = ComboBox1.Value
.Range("D" & lastrow).Value = TextBox3.Value
.Range("E" & lastrow).Value = TextBox4.Value
.Range("F" & lastrow).Value = TextBox5.Value
.Range("G" & lastrow).Value = TextBox6.Value
.Range("H" & lastrow).Value = TextBox7.Value
.Range("I" & lastrow).Value = TextBox8.Value
.Range("J" & lastrow).Value = TextBox9.Value
End With
Else
MsgBox str_search & " Wrongg"
End If
End Function

Function search_from_form()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Database").Activate
Set rng1 = Sheets("Database").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
TextBox1.Value = Sheets("Database").Range("A" & row_number).Value
TextBox2.Value = Sheets("Database").Range("B" & row_number).Value
ComboBox1.Value = Sheets("Database").Range("C" & row_number).Value
TextBox3.Value = Sheets("Database").Range("D" & row_number).Value
TextBox4.Value = Sheets("Database").Range("e" & row_number).Value
TextBox5.Value = Sheets("Database").Range("F" & row_number).Value
TextBox6.Value = Sheets("Database").Range("G" & row_number).Value
TextBox7.Value = Sheets("Database").Range("H" & row_number).Value
TextBox8.Value = Sheets("Database").Range("I" & row_number).Value
TextBox9.Value = Sheets("Database").Range("J" & row_number).Value
Else
MsgBox str_search & " - Not Found"
End If
End Function

Function edit_from_form()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Database").Activate
Set rng1 = Sheets("Database").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
With ActiveWorkbook.Sheets("Database")
.Range("A" & row_number).Value = TextBox1.Value
.Range("B" & row_number).Value = TextBox2.Value
.Range("C" & row_number).Value = ComboBox1.Value
.Range("D" & row_number).Value = TextBox3.Value
.Range("E" & row_number).Value = TextBox4.Value
.Range("F" & row_number).Value = TextBox5.Value
.Range("G" & row_number).Value = TextBox6.Value
.Range("H" & row_number).Value = TextBox7.Value
.Range("I" & row_number).Value = TextBox8.Value
.Range("J" & row_number).Value = TextBox9.Value
End With
Else
MsgBox str_search & "Not Found"
End If
End Function

Function delete_from_form_with_confirmation()
Dim answer As Integer
answer = MsgBox("Delete This Row of Data", vbQuestion + vbYesNo + vbDefaultButton2, "Confirmation")
If answer = vbYes Then
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Database").Activate
Set rng1 = Sheets("Database").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ActiveWorkbook.Sheets("Database").Rows(row_number).EntireRow.Delete
Else
End If
End If
End Function

Function reset_all_controls()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButton"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl
End Function

Function show_data_in_listbox()
ListBox1.ColumnCount = 10
ListBox1.ColumnWidths = "60,150,65,80,80,80,80,90,60,60"
Sheets("Database").Activate
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
ListBox1.List = Range("A1:J" & lastrow).Value
End Function

Function extract_data_in_listbox()
Dim row_number As Integer
For row_number = 0 To ListBox1.ListCount
If (ListBox1.Selected(row_number) = True) Then
TextBox1 = ListBox1.List(row_number, 0)
TextBox2 = ListBox1.List(row_number, 1)
ComboBox1 = ListBox1.List(row_number, 2)
TextBox3 = ListBox1.List(row_number, 3)
TextBox4 = ListBox1.List(row_number, 4)
TextBox5 = ListBox1.List(row_number, 5)
TextBox6 = ListBox1.List(row_number, 6)
TextBox7 = ListBox1.List(row_number, 7)
TextBox8 = ListBox1.List(row_number, 8)
TextBox9 = ListBox1.List(row_number, 9)
End If
Next row_number
End Function

Function filter_data_in_listbox()
Call show_data_in_listbox
Dim i As Integer
Dim ListCount1 As Integer
ListCount1 = ListBox1.ListCount - 1
If TextBox2 <> "" Then
For i = ListCount1 To 0 Step -1
If InStr(1, ListBox1.List(i, 1), TextBox2) = 0 Then
ListBox1.RemoveItem (i)
End If
Next i
End If
End Function

Private Sub Label3_Click()

End Sub

Private Sub ListBox1_Change()
Call extract_data_in_listbox
End Sub


Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label4.Caption = Time
End Sub

Private Sub main_frame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'this one for Live Time on screen
Label4.Caption = Time
End Sub

Private Sub TextBox2_AfterUpdate()
    'This one for the Date box format
On Error Resume Next
Me.TextBox3 = Format(CDate(Me.TextBox3), "dd-mmm-yyyy")
End Sub

Private Sub CommandButton1_Click()
    'This one to hide the form and open database sheet
Me.Hide
Application.Visible = True
ThisWorkbook.Sheets("Database").Activate
End Sub

Private Sub CommandButton2_Click()
    'For insert button
Call copy_from_form_without_repeat
Call reset_all_controls
Call show_data_in_listbox
End Sub

Private Sub CommandButton3_Click()
    'For Search button
Call search_from_form
End Sub

Private Sub CommandButton4_Click()
    'For Modify button
Call edit_from_form
Call reset_all_controls
Call show_data_in_listbox
End Sub

Private Sub CommandButton5_Click()
    'For Delete button
Call delete_from_form_with_confirmation
End Sub

Private Sub CommandButton6_Click()
    'For Reset button
Call reset_all_controls
Call show_data_in_listbox
End Sub

Private Sub CommandButton7_Click()
    'For Date Search button
Call filter_data_in_listbox
End Sub

Private Sub CommandButton8_Click()
    'For QUIT button which not created yet
ThisWorkbook.Save
Application.Quit
End Sub

Private Sub UserForm_Initialize()
Label4.Caption = Time
Label5.Caption = Format(Date, "dd - mm - yyyy")
ComboBox1.AddItem "Normal"
ComboBox1.AddItem "Weekend"
ComboBox1.AddItem "Holiday"
Call show_data_in_listbox
End Sub

Private Sub login_form_Click()
    'this one to load the login user form
Application.ScreenUpdating = False
admin_login_form.Show
Application.ScreenUpdating = True
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
Application.Quit
ThisWorkbook.Close Not CBool(ThisWorkbook.Saved)
End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
Hi and welcome to MrExcel.
See if this works. i have not tested

VBA Code: 
Function show_data_in_listbox()
    Dim lastrow As Long, Row As Long, Col As Long, TempArray
   
    With Sheets("Database")
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        TempArray = .Range("A1:J" & lastrow).Value
        For Row = 1 To lastrow
            For Col = 4 To 10
                TempArray(Row, Col) = Format(TempArray(Row, Col), "HH:MM")
            Next Col
            TempArray(Row, 2) = Format(TempArray(Row, 2), "DDD MM DD,YYYY")
        Next Row
    End With
    With ListBox1
        .ColumnCount = 10
        .ColumnWidths = "60,150,65,80,80,80,80,90,60,60"
        .List = TempArray
    End With
End Function
 
Upvote 0
Solution
diddi said:
Hi and welcome to MrExcel.
See if this works. i have not tested

VBA Code: 
Function show_data_in_listbox()
    Dim lastrow As Long, Row As Long, Col As Long, TempArray
  
    With Sheets("Database")
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        TempArray = .Range("A1:J" & lastrow).Value
        For Row = 1 To lastrow
            For Col = 4 To 10
                TempArray(Row, Col) = Format(TempArray(Row, Col), "HH:MM")
            Next Col
            TempArray(Row, 2) = Format(TempArray(Row, 2), "DDD MM DD,YYYY")
        Next Row
    End With
    With ListBox1
        .ColumnCount = 10
        .ColumnWidths = "60,150,65,80,80,80,80,90,60,60"
        .List = TempArray
    End With
End Function
Click to expand...
It's working perfectly
really appreciated and thank you so much
 
Upvote 0
Good to hear! note that I did not use worksheets .Activate in the code. Activating sheets is not needed and slows your code ;)
 
Upvote 0
diddi said:
Good to hear! note that I did not use worksheets .Activate in the code. Activating sheets is not needed and slows your code ;)
Click to expand...
There is a mistake with this one when i click on the listbox1 idk why ?
then it gives me an error message "Run Time error "70" permission denied" - "Can't execute code in break mode"
sorry for bothering but i started to learn vba 1 week ago
VBA Code: 
Function show_data_in_listbox_1()
    Dim lastrow As Long, Row As Long, Col As Long, TempArray
   
    With Sheets("Live Database")
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        TempArray = .Range("A1:I" & lastrow).Value
        For Row = 1 To lastrow
            For Col = 3 To 9
                TempArray(Row, Col) = Format(TempArray(Row, Col), "[$-x-systime]h:mm:ss AM/PM")
            Next Col
            TempArray(Row, 2) = Format(TempArray(Row, 2), "DDD MM DD,YYYY")
        Next Row
    End With
    With ListBox1
        .ColumnCount = 9
        .ColumnWidths = "125,45,55,55,55,55,70,66,60"
        .List = TempArray
    End With
End Function
trying to create a login and logout userform for my online job..

^_^

VBA Code: 
Option Explicit

Function copy_without_repeat_1in()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ThisWorkbook.Sheets("Live Database").Activate
Set rng1 = Sheets("Live Database").Range("A:A").Find(str_search, , xlValues, xlWhole)
If rng1 Is Nothing Then
Dim lastrow As Long
lastrow = ThisWorkbook.Sheets("Live Database").Range("A1000000").End(xlUp).Row
lastrow = lastrow + 1
With ThisWorkbook.Sheets("Live Database")
.Range("A" & lastrow) = TextBox1.Value
.Range("B" & lastrow) = ComboBox1.Value
.Range("C" & lastrow) = TextBox2.Value
End With
Else
MsgBox str_search & " is Found"
End If
End Function



Function edit_from_sheet_1out()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ThisWorkbook.Sheets("Live Database").Activate
Set rng1 = Sheets("Live Database").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ThisWorkbook.Sheets("Live Database").Activate
Sheets("Live Database").Range("A" & row_number) = TextBox1.Value
Sheets("Live Database").Range("B" & row_number) = ComboBox1.Value
Sheets("Live Database").Range("D" & row_number) = TextBox2.Value
Else
MsgBox str_search & "Not Found"
End If
End Function

Function edit_from_sheet_2in()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ThisWorkbook.Sheets("Live Database").Activate
Set rng1 = Sheets("Live Database").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ThisWorkbook.Sheets("Live Database").Activate
Sheets("Live Database").Range("A" & row_number) = TextBox1.Value
Sheets("Live Database").Range("B" & row_number) = ComboBox1.Value
Sheets("Live Database").Range("E" & row_number) = TextBox2.Value
Else
MsgBox str_search & "Not Found"
End If
End Function

Function edit_from_sheet_2out()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ThisWorkbook.Sheets("Live Database").Activate
Set rng1 = Sheets("Live Database").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ThisWorkbook.Sheets("Live Database").Activate
Sheets("Live Database").Range("A" & row_number) = TextBox1.Value
Sheets("Live Database").Range("B" & row_number) = ComboBox1.Value
Sheets("Live Database").Range("F" & row_number) = TextBox2.Value
Else
MsgBox str_search & "Not Found"
End If
End Function

Function reset_all_controls()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButton"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl
End Function

Function items_from_code_to_combobox_1()
ComboBox1.AddItem "Normal"
ComboBox1.AddItem "Weekend"
ComboBox1.AddItem "Holiday"
End Function

Function show_data_in_listbox_999()
ListBox1.ColumnCount = 9
ListBox1.ColumnWidths = "100,100,100,100,100,100,100,100,100"
Sheets("Live Database").Activate
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
ListBox1.List = Range("A1:I" & lastrow).Value
End Function


Function show_data_in_listbox_1()
    Dim lastrow As Long, Row As Long, Col As Long, TempArray
   
    With Sheets("Live Database")
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        TempArray = .Range("A1:I" & lastrow).Value
        For Row = 1 To lastrow
            For Col = 3 To 9
                TempArray(Row, Col) = Format(TempArray(Row, Col), "[$-x-systime]h:mm:ss AM/PM")
            Next Col
            TempArray(Row, 2) = Format(TempArray(Row, 2), "DDD MM DD,YYYY")
        Next Row
    End With
    With ListBox1
        .ColumnCount = 9
        .ColumnWidths = "125,45,55,55,55,55,70,66,60"
        .List = TempArray
    End With
End Function



Private Sub CommandButton1_Click()
Call copy_without_repeat_1in
Call show_data_in_listbox_1
End Sub

    Private Sub CommandButton2_Click()
Call edit_from_sheet_1out
Call show_data_in_listbox_1
End Sub

Private Sub CommandButton3_Click()
Call edit_from_sheet_2in
Call show_data_in_listbox_1
End Sub

Private Sub CommandButton4_Click()
Call edit_from_sheet_2out
Call show_data_in_listbox_1
End Sub

Private Sub CommandButton5_Click()
Me.Hide
Application.Visible = True
ThisWorkbook.Sheets("Live Database").Activate
End Sub

Private Sub CommandButton6_Click()
ThisWorkbook.Save
Application.Quit
End Sub
Private Sub ListBox1_Change()
Call show_data_in_listbox_1
End Sub



Private Sub UserForm_Initialize()
Call items_from_code_to_combobox_1
Call show_data_in_listbox_1
TextBox1.Value = Format(Date, "[$-ar-AR]dddd, d , mmmm, yyyy")
Application.Run "clock1"
TextBox2.Value = Format(Date, "[$-x-systime]h:mm:ss AM/PM")
Application.Run "clock1"
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
clock2
End Sub
The database = "live Datebase"
colm, A1:I1
Date, Day type, 1st login, 1st logout, 2nd login, 2nd logout, working hours, over time delay time (8:00 hours required for the day)
dat type 3 kinds (Normal, weekend,holiday)
if weekend or holiday no delay just all in over time
 

Attachments

  • Untitled_4444.jpg
    Untitled_4444.jpg
    215.7 KB · Views: 22
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Putting data into ListBox1 from UserForm6 to Userform1 listbox
Replies
5
Views
490
dmt32
D
K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
238
krunal123
K
I
  • Question Question
Run time erorr 94 when selecting value in Listbox
Replies
4
Views
105
ipbr21054
I
K
  • Question Question
Help Needed
2
Replies
13
Views
334
kwavic
K
I
  • Question Question
Use the majority of an existing working code in new project advice
Replies
1
Views
220
ipbr21054
I

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top