What am I missing in "this code will select the checkbox on the tab for the dupl rec"
I'm trying to figure out where the error in my code is or if I need to be trying to create my additional records another way. So far with the code below I can create the additional records according to the extra (Time) checkboxes selected on the form by the user.
Problem is I have a form with several tabs and on each tab are checkbox items that the user can select. All the checkboxes that are checked on the various tabs are listed in a text box on the main form for the users reference just before they commit the record.
I need each duplicate record to also have whatever checkboxes were selected in the main record to also be selected on it. The records are not exact duplicates since the record time selected by the user is different for each record.
I'm trying to figure out where the error in my code is or if I need to be trying to create my additional records another way. So far with the code below I can create the additional records according to the extra (Time) checkboxes selected on the form by the user.
Problem is I have a form with several tabs and on each tab are checkbox items that the user can select. All the checkboxes that are checked on the various tabs are listed in a text box on the main form for the users reference just before they commit the record.
I need each duplicate record to also have whatever checkboxes were selected in the main record to also be selected on it. The records are not exact duplicates since the record time selected by the user is different for each record.
Code:
Option Compare Database
Option Explicit
Private Function SubAddRecords()
'this function will call the Subroutine AddRecords_Click() code below so that I can use this _
function to call from the VCR control macros on the main form.
Call AddRecords_Click
End Function
Sub AddRecords_Click()
Dim varTime As String
If cb630AM.Value = True Then
varTime = "6:30am"
Call addentry(varTime)
End If
If cb830AM.Value = True Then
varTime = "8:30am"
Call addentry(varTime)
End If
If cb1030AM.Value = True Then
varTime = "10:30am"
Call addentry(varTime)
End If
If cb1230PM.Value = True Then
varTime = "12:30pm"
Call addentry(varTime)
End If
If cb230PM.Value = True Then
varTime = "2:30pm"
Call addentry(varTime)
End If
If cbEndDays.Value = True Then
varTime = "End-Days"
Call addentry(varTime)
End If
If cb630PM.Value = True Then
varTime = "6:30pm"
Call addentry(varTime)
End If
If cb830PM.Value = True Then
varTime = "8:30pm"
Call addentry(varTime)
End If
If cb1030PM.Value = True Then
varTime = "10:30pm"
Call addentry(varTime)
End If
If cb1230AM.Value = True Then
varTime = "12:30am"
Call addentry(varTime)
End If
If cb230AM.Value = True Then
varTime = "2:30am"
Call addentry(varTime)
End If
If cbEndNights.Value = True Then
varTime = "End-Nights"
Call addentry(varTime)
End If
End Sub
Private Function addentry(varTime As String)
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tblProductionNumbers", dbOpenDynaset)
rs.AddNew
rs("ManHoursID") = Me.ManHoursID.Value
rs("ProductionDate") = Me.ProductionDate.Value
rs("TimeID") = varTime
rs("Line#ID") = LineID.Value
rs("ProductID") = Me.ProductID.Value
rs("OperatorID") = Me.OperatorID.Value
rs("TailOffID") = Me.TailOffID.Value
rs("LF Run") = Me.[LF Run].Value
rs("LF Produced") = Me.[LF Produced].Value
rs("Comments") = Me.Comments.Value
rs("UserSelectedTabItems") = Me.UserSelectedTabItems.Value 'this populates the textbox on created record
'This code will make sure the checkboxes on the various tabs are carried over to the newely created record.
rs("ImajePrinterMotorRPMTooLow") = Me.ImajePrinterMotorRPMTooLow.Value
If Me.ImajePrinterMotorRPMTooLow = -1 Then 'this code will select the checkbox on the tab for the dupl record
Else
Me.UserSelectedTabItems = Replace(Me.UserSelectedTabItems, _
"ImajePrinterMotorRPMTooLow" & vbNewLine, "") 'this code will remove the check in checkbox if item unchecked in record
End If
'
rs("CoolingBoxesRollersCupping") = Me.CoolingBoxesRollersCupping.Value
If Me.CoolingBoxesRollersCupping = -1 Then
Else
Me.UserSelectedTabItems = Replace(Me.UserSelectedTabItems, _
"CoolingBoxesRollersCupping" & vbNewLine, "")
End If
'
rs("CoolingBoxesRollersLineBreakinginFirstCoolingBox") = Me.CoolingBoxesRollersLineBreakinginFirstCoolingBox.Value
If Me.CoolingBoxesRollersLineBreakinginFirstCoolingBox = -1 Then
Else
Me.UserSelectedTabItems = Replace(Me.UserSelectedTabItems, _
"CoolingBoxesRollersLineBreakinginFirstCoolingBox" & vbNewLine, "")
End If
'
rs("CutterCutterBrainResetButtonInoperable") = Me.CutterCutterBrainResetButtonInoperable.Value
If Me.CutterCutterBrainResetButtonInoperable = -1 Then
Else
Me.UserSelectedTabItems = Replace(Me.UserSelectedTabItems, _
"CutterCutterBrainResetButtonInoperable" & vbNewLine, "")
End If
'
rs("CutterProductBackedUp") = Me.CutterProductBackedUp.Value
If Me.CutterProductBackedUp = -1 Then
Else
Me.UserSelectedTabItems = Replace(Me.UserSelectedTabItems, _
"CutterProductBackedUp" & vbNewLine, "")
End If
'
rs("DieRazorLaminatorBeadDropping") = Me.DieRazorLaminatorBeadDropping.Value
If Me.DieRazorLaminatorBeadDropping = -1 Then
Else
Me.UserSelectedTabItems = Replace(Me.UserSelectedTabItems, _
"DieRazorLaminatorBeadDropping" & vbNewLine, "")
End If
'
rs("DieRazorLaminatorDimples") = Me.DieRazorLaminatorDimples.Value
If Me.DieRazorLaminatorDimples = -1 Then
Else
Me.UserSelectedTabItems = Replace(Me.UserSelectedTabItems, _
"DieRazorLaminatorDimples" & vbNewLine, "")
End If
'
rs("DieRazorLaminatorHook") = Me.DieRazorLaminatorHook.Value
If Me.DieRazorLaminatorHook = -1 Then
Else
Me.UserSelectedTabItems = Replace(Me.UserSelectedTabItems, _
"DieRazorLaminatorHook" & vbNewLine, "")
End If
rs.Update
rs.Close
db.Close
End Function
Private Function ClearCheckBoxes()
cbEndNights.Value = False
cb630AM.Value = False
cb830AM.Value = False
cb1030AM.Value = False
cb1230PM.Value = False
cb230PM.Value = False
cbEndDays.Value = False
cb630PM.Value = False
cb830PM.Value = False
cb1030PM.Value = False
cb1230AM.Value = False
cb230AM.Value = False
End Function
Private Sub cb630AM_Click()
If cboTime = "6:30am" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb630AM.Value = False
Else
End If
End Sub
Private Sub cb830AM_Click()
If cboTime = "8:30am" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb830AM.Value = False
Else
End If
End Sub
Private Sub cb1030AM_Click()
If cboTime = "10:30am" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb1030AM.Value = False
Else
End If
End Sub
Private Sub cb1230PM_Click()
If cboTime = "12:30pm" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb1230PM.Value = False
Else
End If
End Sub
Private Sub cb230PM_Click()
If cboTime = "2:30pm" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb230PM.Value = False
Else
End If
End Sub
Private Sub cbEndDays_Click()
If cboTime = "End-Days" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cbEndDays.Value = False
Else
End If
End Sub
Private Sub cb630PM_Click()
If cboTime = "6:30pm" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb630PM.Value = False
Else
End If
End Sub
Private Sub cb830PM_Click()
If cboTime = "8:30pm" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb830PM.Value = False
Else
End If
End Sub
Private Sub cb1030PM_Click()
If cboTime = "10:30pm" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb1030PM.Value = False
Else
End If
End Sub
Private Sub cb1230AM_Click()
If cboTime = "12:30am" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb1230AM.Value = False
Else
End If
End Sub
Private Sub cb230AM_Click()
If cboTime = "2:30am" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cb230AM.Value = False
Else
End If
End Sub
Private Sub cbEndNights_Click()
If cboTime = "End-Nights" Then
DoCmd.Beep
msgbox "You cannot select the SAME TIME twice. Please try your selections again"
cbEndNights.Value = False
Else
End If
End Sub