We help IT Professionals succeed at work.
Get Started

ctl.ItemsSelected for Combo Box

francodhs
francodhs asked
on
344 Views
Last Modified: 2012-05-12
Hello to All:

I noticed a small bug in my program that I hope someone can help me resolve.  The Shift combo box contains a number of shifts.  The feature of this form generates three pay periods with either one assignment for all three or up to three different assignemnts for all three.

Example #1 for three different assignments

First = A 0900
Second = BGC 0730
Third = FLETC 0730


Example #2 for one assignment

First = A 0900
Second = A 0900
Third = A 0900

Now, the code works well when three assignments are selected and they are popoluated on the Employee form. For those employees that are assigned the same shift for all three pay periods, when I hit submit, the assignments default to the first selection of the combo box, which is "A 0700".  I don't know why it's doing this, but I'm sure it's an easy fix for someone more experienced in dealing with counters.

A demo copy of the program is attached as reference.
Private Sub Command4_Click()

On Error GoTo No_Duplicates

MsgBox "This may take a moment.  Click OK to continue..."

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim X As Integer       'three pay period day counter
    Dim ctl As Control     'listbox control on form
    Dim CurDate As Date
    Dim PP As Integer      'pay period counter
    Dim Z As Integer       'running day counter
    Dim varItem As Variant 'shift selected from listbox
    Dim i As Long
    Dim j As Integer
    
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("qryShift", dbOpenDynaset)
    'FirstShift is the multiselect listbox used for selecting the shift
    'it has four columns...the column for the shiftID is the bound column

    Set ctl = Me.FirstShift
    
    
    If IsNull(Me.PayPeriod) Then
        MsgBox "You did not select a starting pay period # from the list" _
         , vbExclamation, "Nothing Selected!"
        Exit Sub
    End If
    
    If IsNull(Me.StartDate) Then
        MsgBox "You did not select a start date." _
         , vbExclamation, "Nothing Selected!"
        Exit Sub
    End If
    
    Select Case ctl.ItemsSelected.Count
        Case 0
            MsgBox "You did not select a shift from the list" _
            , vbExclamation, "Nothing Selected!"
            Exit Sub
        Case 3
            With rs
            'initialize counters
            X = 0
            PP = 0
            Z = 0
        
            For Each varItem In ctl.ItemsSelected
                For X = 0 To 13    'daily process for one biweekly pay period.
                    Z = Z + 1      'cumulative counter 3 x 14 = 42 days
                    PP = Int(Round(Z / 14, 0))          'used to identify the pay period
                    If Z > 0 And Z < 15 Then
                        CurDate = DateAdd("d", Z, StartDate - 1)    'x initialized to 1;offset is in start date
                        PP = 1
                    ElseIf Z > 14 And Z < 29 Then
                        CurDate = DateAdd("d", Z, StartDate - 1) 'x initialized to 1;offset is in start date
                        PP = 2
                    Else
                        CurDate = DateAdd("d", Z, StartDate - 1)
                        PP = 3
                    End If
                                
                
                    rs.AddNew
                            If Me.Controls("Day" & (Z)) Then
                                rs!EmployeeShiftID = ctl.Column(0, varItem)
                                rs!Shift = ctl.Column(1, varItem)
                                rs!Time = ctl.Column(2, varItem)
                            
                                If (Me.PayPeriod - 1) + PP < 27 Then
                                    rs!PayPeriod = (Me.PayPeriod - 1) + PP
                                Else
                                    rs!PayPeriod = PP - 1
                                End If
                        
                                rs!EmployeeID = Me.txtEmployeeID
                                rs!Date = CurDate
                            
                            Else
                        
                        
                                rs!EmployeeShiftID = 45
                                rs!Shift = "RDO"
                                rs!Time = "RDO"
                            
                                If (Me.PayPeriod - 1) + PP < 27 Then
                                    rs!PayPeriod = (Me.PayPeriod - 1) + PP
                                Else
                                    rs!PayPeriod = PP - 1
                                End If
                            
                            
                                rs!EmployeeID = Me.txtEmployeeID
                                rs!Date = CurDate
                            End If
                        
                    rs.Update
            
                Next X
        
                       
            Next varItem
                 
        End With
    Case 1
        With rs
            'initialize counters
            X = 0
            PP = 0
            Z = 0
            j = 1
            For j = 1 To 3
                For X = 0 To 13    'daily process for one biweekly pay period.
                    Z = Z + 1      'cumulative counter 3 x 14 = 42 days
                    PP = Int(Round(Z / 14, 0))          'used to identify the pay period
                    If Z > 0 And Z < 15 Then
                        CurDate = DateAdd("d", Z, StartDate - 1)    'x initialized to 1;offset is in start date
                        PP = 1
                    ElseIf Z > 14 And Z < 29 Then
                        CurDate = DateAdd("d", Z, StartDate - 1) 'x initialized to 1;offset is in start date
                        PP = 2
                    Else
                        CurDate = DateAdd("d", Z, StartDate - 1)
                        PP = 3
                    End If
                                
                
                    rs.AddNew
                            If Me.Controls("Day" & (Z)) Then
                                rs!EmployeeShiftID = ctl.Column(0, 1)
                                rs!Shift = ctl.Column(1, 1)
                                rs!Time = ctl.Column(2, 1)
                            
                                If (Me.PayPeriod - 1) + PP < 27 Then
                                    rs!PayPeriod = (Me.PayPeriod - 1) + PP
                                Else
                                    rs!PayPeriod = PP - 1
                                End If
                        
                                rs!EmployeeID = Me.txtEmployeeID
                                rs!Date = CurDate
                            
                            Else
                        
                        
                                rs!EmployeeShiftID = 45
                                rs!Shift = "RDO"
                                rs!Time = "RDO"
                            
                                If (Me.PayPeriod - 1) + PP < 27 Then
                                    rs!PayPeriod = (Me.PayPeriod - 1) + PP
                                Else
                                    rs!PayPeriod = PP - 1
                                End If
                            
                            
                                rs!EmployeeID = Me.txtEmployeeID
                                rs!Date = CurDate
                            End If
                        
                    rs.Update
            
                Next X
        
                       
            Next j
                 
        End With
    End Select
       
    
            
    rs.Close
        
    MsgBox "Process complete.  Click Verify to ensure the data transfered successfully.", vbInformation, "Verify"
    
    Set rs = Nothing

   'clear the selections from the listbox
    For i = 0 To Me.FirstShift.ListCount - 1
        Me.FirstShift.Selected(i) = False
    Next i
    
   'refresh the subform that displays the recordset
    Forms!frmEmployees.Refresh
    
Exit Sub

No_Duplicates:

If Err.Number = 3022 Then
        MsgBox "You already entered a shift(s) for this date(s).  Check the employee main form to verify."
        Else
        
    End If
    
    If Err.Number = 94 Then
        MsgBox "It appears you haven't selected the shift days for all pay periods.  Ensure you leave the buttons blank for the RDOs."
     Else
    End If



End Sub

Private Sub EndDate_Click()
'DoCmd.OpenForm "frmMiniCalendar", , , , , acDialog
    ' move the focus off the date control
    ' Me.EndDate.SetFocus
End Sub

Private Sub FirstShift_Exit(Cancel As Integer)
If Me!FirstShift.ItemsSelected.Count = 1 Then
MsgBox "You have selected only one assignment for all 3 pay periods.  Hit OK to continue."
Me.StartDate.SetFocus
End If

If Me!FirstShift.ItemsSelected.Count > 3 Or Me!FirstShift.ItemsSelected.Count = 2 Then
MsgBox "This is a required field. Ensure you have made a selection.  Also, you can only make 1 or 3 selections at a time."
DoCmd.CancelEvent
Me.FirstShift.SetFocus
Else
Me.StartDate.SetFocus
End If

End Sub

Open in new window

Alpha-Roster-Program-Updated.mdb
Comment
Watch Question
CERTIFIED EXPERT
Commented:
This problem has been solved!
Unlock 1 Answer and 5 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE