• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 257
  • Last Modified:

List Box Selection Using Cumulative Counters

I need assistance with a quick code modification.  I have attached a sample db for reference.  The code snippet is triggered by the 'Submit" button.  Another member did an excellent job in finding solutions to my issue, but something else came up that I hope I can resolve quickly.

The "Batch Entry Form" of my project contains a list box named "FirstShift".  The user needs to make 3 selections in order for the values to generate in the order of selection to the "First", "Second", and "Third" pay periods.  However, some employees may work at one location for all 3 pay periods.  Can someone help me modify the code to also allow the option of selecting only one location for all 3 pay pay periods?  

I can work on an error handler to restrict a user from entering only 2 assignments, as the code will only allow for either 1 or 3 selections, never 2.

Thanks.
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
    
    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 ctl.ItemsSelected.Count = 0 Then
        MsgBox "You did not select a shift from the list" _
         , vbExclamation, "Nothing Selected!"
        Exit Sub
    End If
       
    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
            
    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
        MsgBox Err.Description
    End If

End Sub

Open in new window

Alpha-Roster-Program-Assignments.mdb
0
francodhs
Asked:
francodhs
  • 2
  • 2
1 Solution
 
SafetyFishCommented:
In order to check my understanding, because the relationship between the different selections on this form is unclear to me:

The first step selects the number of pay periods being calculated, right?

If the first is true, then the problem with the form (as I understand it) is that it is designed to accept a "location" for each pay period. These "locations" are chosen from the listbox titled firstshift.

What you want it to do is to give you the option of only selecting a single "location" for the number of pay periods you are calculating regardless of how many pay periods have been selected from the drop down box in step 1?

Why do the pay periods number to 26 when you only have 3 sets of [two weeks of weekdays] on the form?

If it is the case that you want to be able to select a single item from the listbox for multiple items in the pay period drop down box, then you need a way to separate your major loop counter (The line For each varItem in ctl.ItemsSelected), which cycles as many times as there are items selected in the listbox, from the number of times you actually want it to cycle.

Would you prefer to use a hardcoded value of 3, take the number of cycles from the pay periods drop down list, or add a control (textbox, drop down, etc) that would allow you to choose how many times the loop cycles? To be clear, we are talking about the loop in lines 47-101.


0
 
francodhsAuthor Commented:
Thanks for your quick response.  

<The first step selects the number of pay periods being calculated, right?>

Yes.  The user simply enters a pay period number such as 4 and pay period 5 and 6 are automatically generated as part of the code.  So, once the code is modified (with your help), by selecting pay period 4 and only one assignment, that one assignment will apply to all three pay periods.

<Why do the pay periods number to 26 when you only have 3 sets of [two weeks of weekdays] on the form?>

These pay period numbers are the ones we use at work.  So regardless of the number selected, the code will always generate three pay periods (3 two-week sets).

Can we try the hard code option first?  Right now it's  coded to accept only 3 assignments, since selecting only one would only generate a two-week shift.  I still need the 3 assignment option, as some employees will work at different locations each pay period.  I'm trying to target those employees whose assignments never change.  I hope this makes sense.

Thanks SafetyFish.
0
 
SafetyFishCommented:
Yes, I think I get it a little bit better now.

In the code below, I used a select case conditional to choose two different paths. What I think the code says (since I don't completely understand everything going on in the database, I'm going to assume that my code isn't perfect, either) is that if the number of items selected is 3, to run like normal (and therein you will find a perfect copy of what I interpret to be the main body of the code). If the number of items selected is 1, a near copy of the code runs. However, instead of looping the number of times that things have been selected, it loops (hard coded) to 3. This replaces the "For Each VarItem in ctl.selecteditems" line (and the "next varitem" line well below) with the lines "For j = 1 to 3" (where j has been initialized to 1) and "next j". The other three instances of varitem were replaced with the number 1 such that:

rs!EmployeeShiftID = ctl.Column(0, varItem)
rs!Shift = ctl.Column(1, varItem)
rs!Time = ctl.Column(2, varItem)

was replaced with

rs!EmployeeShiftID = ctl.Column(0, 1)
rs!Shift = ctl.Column(1, 1)
rs!Time = ctl.Column(2, 1)

I think this might work, but please let me know. I'm not sure how to interpret the accuracy of the results, myself.


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
    
    
    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
        MsgBox Err.Description
    End If

End Sub

Open in new window

0
 
francodhsAuthor Commented:
That was it.  Good show!  Thanks buddy.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now