This code goes through 3 work sheets in the same XL workbook, day, eve and
night shift
in each sheet their are columns representing production work orders and
reject and downtime for each order
so in the tblproductiondetail there is one record for each work order and
many reject or downtime records (one to many)
code works fine to get a new record for each work order main info but when
creating the sub table related records for rejcts and downtime it writes the
same autonumber over and over again.
Public Sub dBSAVE()
DayShift
EveningShift
NightShift
End Sub
Sub NightShift()
Dim db As Database
Dim rs As Recordset
Sheets("Night Shift Report").Select
Dim col As Integer
Dim row As Integer
Dim inc As Integer
Dim prodcode As Long
Set db = OpenDatabase("S:\Production Database\ProductionData_tables.MDB")
For col = 2 To 17 Step 3
Sheets("Night Shift Report").Select
If Worksheets("Night Shift Report").Cells(10, col).Value = "" Then Exit
For
Set rs = db.OpenRecordset("tblProductionRunDetail")
Dim NightId As Long
With rs
.AddNew
rs(2) = ActiveSheet.Range("k3").Value 'date
rs(3) = ActiveSheet.Range("k4").Value 'supervisor
rs(4) = ActiveSheet.Range("h3").Value ' shift
rs(5) = ActiveSheet.Range("h4").Value ' time
rs(6) = Worksheets("Night Shift Report").Cells(10, col).Value
'product
rs(7) = Worksheets("Night Shift Report").Cells(14, col).Value ' good
rs(8) = Worksheets("Night Shift Report").Cells(64, col).Value ' bad
rs(9) = Worksheets("Night Shift Report").Cells(24, col).Value '
dryWt
rs(10) = Worksheets("Night Shift Report").Cells(23, col).Value '
wetwt
rs(11) = Worksheets("Night Shift Report").Cells(27, col).Value '
wttest
rs(12) = Worksheets("Night Shift Report").Cells(31, col).Value '
grosshours
.Update
End With
rs.MoveLast ' to get the autonumber field
NightId = rs(0)
rs.Close
'Rejects-------------------------------------------------------------
Set db = OpenDatabase("S:\Production
Database\ProductionData_tables.MDB")
Set rs = db.OpenRecordset("tblProductionRunRejects")
For row = 44 To 63 Step 1
If Worksheets(strSheet).Cells(row, col).Value = "" Then Exit For
rs.AddNew
rs(1) = NightId
rs(2) = Worksheets("Night Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Night Shift Report").Cells(row, col + 1).Value
rs.Update
Next row
rs.Close
' Downtime-----------------------------------------------------------
Set db = OpenDatabase("S:\Production
Database\ProductionData_tables.MDB")
Set rs = db.OpenRecordset("tblProductionRunDownTime")
For row = 37 To 39 Step 1
If Worksheets("Night Shift Report").Cells(row, col).Value = "" Then
Exit For
rs.AddNew
rs(1) = NightId
rs(2) = Worksheets("Night Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Night Shift Report").Cells(row, col + 1).Value
rs.Update
Next row
rs.Close
Next col
End Sub
Public Sub DayShift()
Dim db As Database
Dim rs As Recordset
Sheets("Day Shift Report").Select
Dim col As Integer
Dim row As Integer
Dim inc As Integer
Set db = OpenDatabase("S:\Production
Database\ProductionData_tables.MDB")
For col = 2 To 17 Step 3
Dim DayID As Long
If Worksheets("Day Shift Report").Cells(10, col).Value = "" Then Exit
For
Set rs = db.OpenRecordset("tblProductionRunDetail")
With rs
.AddNew
rs(2) = ActiveSheet.Range("k3").Value 'date
rs(3) = ActiveSheet.Range("k4").Value 'supervisor
rs(4) = ActiveSheet.Range("h3").Value ' shift
rs(5) = ActiveSheet.Range("h4").Value ' time
rs(6) = Worksheets("Day Shift Report").Cells(10, col).Value 'product
rs(7) = Worksheets("Day Shift Report").Cells(14, col).Value ' good
rs(8) = Worksheets("Day Shift Report").Cells(64, col).Value ' bad
rs(9) = Worksheets("Day Shift Report").Cells(24, col).Value ' dryWt
rs(10) = Worksheets("Day Shift Report").Cells(23, col).Value ' wetwt
rs(11) = Worksheets("Day Shift Report").Cells(27, col).Value '
wttest
rs(12) = Worksheets("Day Shift Report").Cells(31, col).Value '
grosshours
.Update
End With
rs.MoveFirst
rs.MoveLast
DayID = rs(0)
Debug.Print "DAY"; DayID; "RC"; rs.RecordCount
rs.Close
'Rejects-------------------------------------------------------------
Set rs = db.OpenRecordset("tblProductionRunRejects")
For row = 44 To 63 Step 1
If Worksheets("Day Shift Report").Cells(row, col).Value = "" Then
Exit For
rs.AddNew
rs(1) = DayID
rs(2) = Worksheets("Day Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Day Shift Report").Cells(row, col + 1).Value
rs.Update
Next row
rs.Close
' Downtime-----------------------------------------------------------
Set db = OpenDatabase("S:\Production
Database\ProductionData_tables.MDB")
Set rs = db.OpenRecordset("tblProductionRunDownTime")
For row = 37 To 39 Step 1
If Worksheets("Day Shift Report").Cells(row, col).Value = "" Then Exit
For
rs.AddNew
rs(1) = DayID
rs(2) = Worksheets("Day Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Day Shift Report").Cells(row, col + 1).Value
rs.Update
Next row
rs.Close
Next col
End Sub
Public Sub EveningShift()
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase("S:\Production Database\ProductionData_tables.MDB")
Dim strSheet As String
Sheets("Evening Shift Report").Select
strSheet = "Evening Shift Report"
Dim col As Integer
Dim row As Integer
Dim inc As Integer
For col = 2 To 17 Step 3
If Worksheets("Evening Shift Report").Cells(10, col).Value = "" Then
Exit For
Set rs = db.OpenRecordset("tblProductionRunDetail")
Dim Eveningid As Long
With rs
.AddNew
rs(2) = ActiveSheet.Range("k3").Value 'date
rs(3) = ActiveSheet.Range("k4").Value 'supervisor
rs(4) = ActiveSheet.Range("h3").Value ' shift
rs(5) = ActiveSheet.Range("h4").Value ' time
rs(6) = Worksheets("Evening Shift Report").Cells(10, col).Value
'product
rs(7) = Worksheets("Evening Shift Report").Cells(14, col).Value '
good
rs(8) = Worksheets("Evening Shift Report").Cells(64, col).Value '
bad
rs(9) = Worksheets("Evening Shift Report").Cells(24, col).Value '
dryWt
rs(10) = Worksheets("Evening Shift Report").Cells(23, col).Value '
wetwt
rs(11) = Worksheets("Evening Shift Report").Cells(27, col).Value '
wttest
rs(12) = Worksheets("Evening Shift Report").Cells(31, col).Value '
grosshours
.Update
End With
rs.MoveFirst
rs.MoveLast
Eveningid = rs(0)
Debug.Print "EVEn"; Eveningid; "RC"; rs.RecordCount
rs.Close
'Rejects-------------------------------------------------------------
Set db = OpenDatabase("S:\Production
Database\ProductionData_tables.MDB")
Set rs = db.OpenRecordset("tblProductionRunRejects")
For row = 44 To 63 Step 1
If Worksheets("Evening Shift Report").Cells(row, col).Value = "" Then
Exit For
rs.AddNew
rs(1) = Eveningid
rs(2) = Worksheets("Evening Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Evening Shift Report").Cells(row, col + 1).Value
rs.Update
Next row
rs.Close
' Downtime-----------------------------------------------------------
Set db = OpenDatabase("S:\Production
Database\ProductionData_tables.MDB")
Set rs = db.OpenRecordset("tblProductionRunDownTime")
For row = 37 To 39 Step 1
If Worksheets("Evening Shift Report").Cells(row, col).Value = "" Then
Exit For
rs.AddNew
rs(1) = Eveningid
rs(2) = Worksheets("Evening Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Evening Shift Report").Cells(row, col + 1).Value
rs.Update
Next row
rs.Close
Next col
End Sub