We help IT Professionals succeed at work.

ctl.ItemsSelected for Combo Box

francodhs
francodhs asked
on
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

BRONZE EXPERT

Commented:
At first one question: where and why you havee disabled debugger?
Now about your sub:
varItem In ctl.ItemsSelected is selected string number. When only one item is selcted, you always assigning value to string 1:
ctl.Column(0, 1)
You should at first determine selected string. Try to change part of your sub to:
Dim stringnum as integer
For Each varItem In ctl.ItemsSelected
                stringnum = varItem
Next varItem
If Me.Controls("Day" & (Z)) Then
                                rs!EmployeeShiftID = ctl.Column(0, stringnum)
                                rs!Shift = ctl.Column(1, stringnum)
                                rs!Time = ctl.Column(2, stringnum)

Author

Commented:
als315:

Thanks for your response.  I didn't realize the debugger was disabled.  I'll take a look at that here shortly.  I tried to apply your suggested code, but the program became unstable.  Right now, it consists of Cases which depends on the number of items selected.  The varitem for Case 3 works fine.  I make three selections and it takes.  But, Case 1 is still an issue and it doesn't seem to be acknowledging the selected string, which is only one item selected, not three. As a result, it defaults to the first item of the combo box (A 0700) each time.  I'm working with an older version of Access (2003), so hopefully if you have time you can open the demo and take a look under the hood.  It's a thorn on my side..  Thanks.
BRONZE EXPERT
Commented:
If you press SHIFT while opening DB, debugger will work and you can trace your code step by step. Here is attached full sub code:
 
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
    Dim stringnum 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
                    For Each varItem In ctl.ItemsSelected
                        stringnum = varItem
                    Next varItem
                    If Me.Controls("Day" & (Z)) Then
                                rs!EmployeeShiftID = ctl.Column(0, stringnum)
                                rs!Shift = ctl.Column(1, stringnum)
                                rs!Time = ctl.Column(2, stringnum)                            
                            
                                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

Author

Commented:
Got it on the debugger.  I'll try the update on Monday and let you know.  Thanks bro.

Author

Commented:
I uploaded the new code.  There were some existing subs on the update you provided that I had to delete, but it works like a charm.  Good show!

Explore More ContentExplore courses, solutions, and other research materials related to this topic.