userfrom consist of 3 list box to insert attendance for employee

**mazan2010** · 07-17-2017, 06:26 PM

Please kindly find attached file want to make the code
i have userform to add attendance to attendance sheet starting in row 8 as in sheet attached
list of operator every time will be appear in list box number one then i select the employee absent list box 2 and transfer to absent list
and if i transfer the data incorrect i can transfer it again to listbox 1
then from list box 1 also i select the employee want to transfer to list box 3 and also can return it again
finally want the sheet come as in my attached file

this is my design
if some one have another simple design can do this in simple way with userform can advice me

**gmr4evr1** · 07-17-2017, 07:19 PM

Something like this...
mazan2010-userfrom-consist-of-3-list-box-to-insert-attendance-for-employee-attendance-userform.xlsm

I haven't coded the Add attendance button yet

**mazan2010** · 07-18-2017, 11:02 AM

Dear gmr4evr1
many thanks for your effort
i test your file an also note that only can transfer one by one and not can retrun data again

Originally Posted by gmr4evr1

Something like this...
Attachment 528375

I haven't coded the Add attendance button yet

**mazan2010** · 07-17-2017, 07:21 PM

Dear gmr4evr1
First I would like to thank you for quick reply
Tomorrow because I didn't have any access to my computer now will check and let you know if it work for me or not
Best regards

**mazan2010** · 07-17-2017, 07:23 PM

Because I replayed you from my phone

**mazan2010** · 07-17-2017, 07:25 PM

And what about add attendance button code

**gmr4evr1** · 07-17-2017, 07:33 PM

You're welcome.
I noticed that I have coded the list box to remove the item selected from listbox1 once it is transferred to one of the other listboxes. If you do not want this to happen, comment out or remove this line..

ListBox1.RemoveItem i

from both of the CommandButton codes.
I haven't coded the add attendance button yet because I wanted to make sure I was doing what you wanted with the other code 1st. I'll work on getting the code done as soon as I can.

**LeoTaxi** · 07-17-2017, 07:56 PM

Made listbox1 multi select, so first select all items

Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, jj As Integer
ReDim arr(1 To ListBox1.ListCount)
ReDim arr2(1 To ListBox1.ListCount)

For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) Then
        j = j + 1
        arr(j) = ListBox1.List(i)
    Else
        jj = jj + 1
        arr2(jj) = ListBox1.List(i)
    End If
Next
ListBox1.Clear
ListBox1.List = arr2
ListBox2.List = arr
End Sub

Private Sub CommandButton2_Click()
With Sheets("Attendance")
    For i = 0 To UserForm1.ListBox1.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox1.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, .Columns.Count).End(xlToLeft).Offset(, 1) = "Present"
    Next
    For i = 0 To UserForm1.ListBox2.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox2.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, .Columns.Count).End(xlToLeft).Offset(, 1) = "Absent"
    Next
    For i = 0 To UserForm1.ListBox3.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox3.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, .Columns.Count).End(xlToLeft).Offset(, 1) = "Present other"
    Next
End With
End Sub

Private Sub CommandButton3_Click()
Dim i As Integer
ReDim arr(1 To ListBox1.ListCount)
ReDim arr2(1 To ListBox1.ListCount)

For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) Then
        j = j + 1
        arr(j) = ListBox1.List(i)
    Else
        jj = jj + 1
        arr2(jj) = ListBox1.List(i)
    End If
Next
ListBox1.Clear
ListBox1.List = arr2
ListBox3.List = arr
End Sub

Kind regards
Leo

**mazan2010** · 07-18-2017, 11:00 AM

Dear Leo
i found your code work good but i note two problem
first when i press add attendance to sheet its add data even the textbox for date is empty and when i press again its the same data to next column and soon without look to corresponding date
also when i press button transfer from is also work good from present list to absent but if i want to return it again its remove the data from list box without return it

Originally Posted by LeoTaxi

Made listbox1 multi select, so first select all items

Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, jj As Integer
ReDim arr(1 To ListBox1.ListCount)
ReDim arr2(1 To ListBox1.ListCount)

For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) Then
        j = j + 1
        arr(j) = ListBox1.List(i)
    Else
        jj = jj + 1
        arr2(jj) = ListBox1.List(i)
    End If
Next
ListBox1.Clear
ListBox1.List = arr2
ListBox2.List = arr
End Sub

Private Sub CommandButton2_Click()
With Sheets("Attendance")
    For i = 0 To UserForm1.ListBox1.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox1.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, .Columns.Count).End(xlToLeft).Offset(, 1) = "Present"
    Next
    For i = 0 To UserForm1.ListBox2.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox2.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, .Columns.Count).End(xlToLeft).Offset(, 1) = "Absent"
    Next
    For i = 0 To UserForm1.ListBox3.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox3.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, .Columns.Count).End(xlToLeft).Offset(, 1) = "Present other"
    Next
End With
End Sub

Private Sub CommandButton3_Click()
Dim i As Integer
ReDim arr(1 To ListBox1.ListCount)
ReDim arr2(1 To ListBox1.ListCount)

For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) Then
        j = j + 1
        arr(j) = ListBox1.List(i)
    Else
        jj = jj + 1
        arr2(jj) = ListBox1.List(i)
    End If
Next
ListBox1.Clear
ListBox1.List = arr2
ListBox3.List = arr
End Sub

Kind regards
Leo

**mazan2010** · 07-18-2017, 11:11 AM

please see my attached file with new userform design

**gmr4evr1** · 07-18-2017, 08:00 AM

Looks like LeoTaxi took care of everything for you. Thanks Leo....nice job. In fact, I think you provided me the code ( about a year ago) that I used and adapted for mazan's workbook.

**mazan2010** · 07-18-2017, 11:18 AM

please see this new attached file

**LeoTaxi** · 07-18-2017, 07:40 PM

With modifications, all listboxes are multi select
you can move between listboxes as match if you want

Private Sub CommandButton1_Click()
Dim i As Integer, mystring As String
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) Then
        ListBox2.AddItem (ListBox1.List(i))
    Else
        If mystring = "" Then
            mystring = ListBox1.List(i) & "|"
        Else
            mystring = mystring & ListBox1.List(i) & "|"
        End If
    End If
Next
ListBox1.Clear
If InStr(1, mystring, "|") > 0 Then
    ListBox1.List = Split(Left(mystring, Len(mystring) - 1), "|")
End If
End Sub

Private Sub CommandButton2_Click()
If Not IsDate(TextBox1) Then
    MsgBox "No valid date"
    TextBox1 = ""
    TextBox1.SetFocus
    Exit Sub
Else
    Dim mydate As Double
    mydate = DateValue(TextBox1)
    With Sheets("Attendance")
        mycol = Application.Match(mydate, .Range("A8", "XFD8"), 0)
    End With
End If
With Sheets("Attendance")
    For i = 0 To UserForm1.ListBox1.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox1.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, mycol) = "Present"
    Next
    For i = 0 To UserForm1.ListBox2.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox2.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, mycol) = "Absent"
    Next
    For i = 0 To UserForm1.ListBox3.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox3.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, mycol) = "Present other"
    Next
End With
Unload Me
End Sub

Private Sub CommandButton3_Click()
Dim i As Integer, mystring As String
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) Then
        ListBox3.AddItem (ListBox1.List(i))
    Else
        If mystring = "" Then
            mystring = ListBox1.List(i) & "|"
        Else
            mystring = mystring & ListBox1.List(i) & "|"
        End If
    End If
Next
ListBox1.Clear
If InStr(1, mystring, "|") > 0 Then
    ListBox1.List = Split(Left(mystring, Len(mystring) - 1), "|")
End If
End Sub


Private Sub CommandButton4_Click()
Dim i As Integer, mystring As String
For i = 0 To ListBox2.ListCount - 1
    If ListBox2.Selected(i) Then
        ListBox1.AddItem (ListBox2.List(i))
    Else
        If mystring = "" Then
            mystring = ListBox2.List(i) & "|"
        Else
            mystring = mystring & ListBox2.List(i) & "|"
        End If
    End If
Next
ListBox2.Clear
If InStr(1, mystring, "|") > 0 Then
    ListBox2.List = Split(Left(mystring, Len(mystring) - 1), "|")
End If
End Sub

Private Sub CommandButton5_Click()
Dim i As Integer, mystring As String
For i = 0 To ListBox2.ListCount - 1
    If ListBox2.Selected(i) Then
        ListBox3.AddItem (ListBox2.List(i))
    Else
        If mystring = "" Then
            mystring = ListBox2.List(i) & "|"
        Else
            mystring = mystring & ListBox2.List(i) & "|"
        End If
    End If
Next
ListBox2.Clear
If InStr(1, mystring, "|") > 0 Then
    ListBox2.List = Split(Left(mystring, Len(mystring) - 1), "|")
End If
End Sub

Private Sub CommandButton6_Click()
Dim i As Integer, mystring As String
For i = 0 To ListBox3.ListCount - 1
    If ListBox3.Selected(i) Then
        ListBox1.AddItem (ListBox3.List(i))
    Else
        If mystring = "" Then
            mystring = ListBox3.List(i) & "|"
        Else
            mystring = mystring & ListBox3.List(i) & "|"
        End If
    End If
Next
ListBox3.Clear
If InStr(1, mystring, "|") > 0 Then
    ListBox3.List = Split(Left(mystring, Len(mystring) - 1), "|")
End If
End Sub

Private Sub CommandButton7_Click()
Dim i As Integer, mystring As String
For i = 0 To ListBox3.ListCount - 1
    If ListBox3.Selected(i) Then
        ListBox2.AddItem (ListBox3.List(i))
    Else
        If mystring = "" Then
            mystring = ListBox3.List(i) & "|"
        Else
            mystring = mystring & ListBox3.List(i) & "|"
        End If
    End If
Next
ListBox3.Clear
If InStr(1, mystring, "|") > 0 Then
    ListBox3.List = Split(Left(mystring, Len(mystring) - 1), "|")
End If
End Sub

Kind regards
Leo

**mazan2010** · 07-19-2017, 12:35 PM

thank you dear LeoTaxi
its work now but only have note when i apply this with my original data its not allow to multiple selection
also i note in your file if i enter result for the same date two times with different data its accept ( can change the code that show message that this date is inserted before do you wt to proceed )

**mazan2010** · 07-19-2017, 01:20 PM

thank you dear LeoTaxi
also if i need to insert date when i press insert attendance instead of date already present in row 8
i mean also want to insert date with attendance in list box

**LeoTaxi** · 07-19-2017, 07:30 PM

Modification in CommandButton2

if date is not found, date and data is coming in first free column in row 8
if date is found but there is already data, user can choose to cancel or replace old data by new

for the multi select you have to change each listbox properties (see picture)

Private Sub CommandButton2_Click()
If Not IsDate(TextBox1) Then
    MsgBox "No valid date"
    TextBox1 = ""
    TextBox1.SetFocus
    Exit Sub
Else
    Dim mydate As Double
    mydate = DateValue(TextBox1)
    With Sheets("Attendance")
        mycol = Application.Match(mydate, .Range("A8", "XFD8"), 0)
        If IsError(mycol) Then
            mycol = .Cells(8, .Columns.Count).End(xlToLeft).Offset(, 1).Column
            .Cells(8, mycol) = mydate
        End If
    End With
End If

With Sheets("Attendance")
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    at = Application.CountA(.Range(.Cells(9, mycol), .Cells(lr, mycol)))
    If at > 0 Then
vervolg:
        j = InputBox("Already data present for this date" & Chr(13) & "1 = Cancel" & Chr(13) & "2 = Replace excisting data by new")
    End If
    If j = 1 Then
        Unload Me
        Exit Sub
    ElseIf j = 2 Then
    For i = 0 To UserForm1.ListBox1.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox1.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, mycol) = "Present"
    Next
    For i = 0 To UserForm1.ListBox2.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox2.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, mycol) = "Absent"
    Next
    For i = 0 To UserForm1.ListBox3.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox3.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, mycol) = "Present other"
    Next
    Else
        GoTo vervolg
    End If
End With
Unload Me
End Sub

**LeoTaxi** · 07-20-2017, 05:08 AM

In this with extra option to choose new date

Private Sub CommandButton2_Click()
If Not IsDate(TextBox1) Then
    MsgBox "No valid date"
    TextBox1 = ""
    TextBox1.SetFocus
    Exit Sub
Else
    Dim mydate As Double
    mydate = DateValue(TextBox1)
    With Sheets("Attendance")
        mycol = Application.Match(mydate, .Range("A8", "XFD8"), 0)
        If IsError(mycol) Then
            mycol = .Cells(8, .Columns.Count).End(xlToLeft).Offset(, 1).Column
            .Cells(8, mycol) = mydate
        End If
    End With
End If

With Sheets("Attendance")
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    at = Application.CountA(.Range(.Cells(9, mycol), .Cells(lr, mycol)))
    If at > 0 Then
vervolg:
        j = InputBox("1 = Cancel" & Chr(13) & "2 = Replace excisting data by new" & Chr(13) & "3 = Choose New Date", "Already data present for this date")
    End If
    If j = 1 Then
        Unload Me
        Exit Sub
    ElseIf j = 2 Then
    For i = 0 To UserForm1.ListBox1.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox1.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, mycol) = "Present"
    Next
    For i = 0 To UserForm1.ListBox2.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox2.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, mycol) = "Absent"
    Next
    For i = 0 To UserForm1.ListBox3.ListCount - 1
        myrow = Application.Match(UserForm1.ListBox3.List(i), .Range("A:A"), 0)
        If Not IsError(myrow) Then .Cells(myrow, mycol) = "Present other"
    Next
    ElseIf j = 3 Then
        TextBox1 = ""
        TextBox1.SetFocus
        Exit Sub
    Else
        GoTo vervolg
    End If
End With
Unload Me
End Sub

Kind regards
Leo

userfrom consist of 3 list box to insert attendance for employee

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Re: userfrom consist of 3 list box to insert attendance for employee

Thread Information

Users Browsing this Thread

Similar Threads

Employee Attendance Tracker Help :)

Employee Attendance help please

[SOLVED] Employee Attendance Template

Track Employee Attendance

Need Help - AutoCalculate Attendance Points for employee attendance records

Employee Attendance Record

employee attendance

Bookmarks

Bookmarks

Posting Permissions