Excel to Access - code issue HELP!!

[AR Hall]

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 tblproductionde tail 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\Produc tionData_tables .MDB")

For col = 2 To 17 Step 3
Sheets("Night Shift Report").Select

If Worksheets("Nig ht Shift Report").Cells( 10, col).Value = "" Then Exit
For

Set rs = db.OpenRecordse t("tblProductio nRunDetail")
Dim NightId As Long
With rs
.AddNew

rs(2) = ActiveSheet.Ran ge("k3").Value 'date
rs(3) = ActiveSheet.Ran ge("k4").Value 'supervisor
rs(4) = ActiveSheet.Ran ge("h3").Value ' shift
rs(5) = ActiveSheet.Ran ge("h4").Value ' time
rs(6) = Worksheets("Nig ht Shift Report").Cells( 10, col).Value
'product
rs(7) = Worksheets("Nig ht Shift Report").Cells( 14, col).Value ' good
rs(8) = Worksheets("Nig ht Shift Report").Cells( 64, col).Value ' bad
rs(9) = Worksheets("Nig ht Shift Report").Cells( 24, col).Value '
dryWt
rs(10) = Worksheets("Nig ht Shift Report").Cells( 23, col).Value '
wetwt
rs(11) = Worksheets("Nig ht Shift Report").Cells( 27, col).Value '
wttest
rs(12) = Worksheets("Nig ht 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\Produc tionData_tables .MDB")
Set rs = db.OpenRecordse t("tblProductio nRunRejects")
For row = 44 To 63 Step 1
If Worksheets(strS heet).Cells(row , col).Value = "" Then Exit For

rs.AddNew
rs(1) = NightId
rs(2) = Worksheets("Nig ht Shift Report").Cells( row, col).Value
rs(3) = Worksheets("Nig ht Shift Report").Cells( row, col + 1).Value
rs.Update
Next row
rs.Close

' Downtime-----------------------------------------------------------
Set db = OpenDatabase("S :\Production
Database\Produc tionData_tables .MDB")
Set rs = db.OpenRecordse t("tblProductio nRunDownTime")
For row = 37 To 39 Step 1
If Worksheets("Nig ht Shift Report").Cells( row, col).Value = "" Then
Exit For
rs.AddNew
rs(1) = NightId
rs(2) = Worksheets("Nig ht Shift Report").Cells( row, col).Value
rs(3) = Worksheets("Nig ht 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\Produc tionData_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.OpenRecordse t("tblProductio nRunDetail")

With rs
.AddNew

rs(2) = ActiveSheet.Ran ge("k3").Value 'date
rs(3) = ActiveSheet.Ran ge("k4").Value 'supervisor
rs(4) = ActiveSheet.Ran ge("h3").Value ' shift
rs(5) = ActiveSheet.Ran ge("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.OpenRecordse t("tblProductio nRunRejects")
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\Produc tionData_tables .MDB")
Set rs = db.OpenRecordse t("tblProductio nRunDownTime")
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\Produc tionData_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("Eve ning Shift Report").Cells( 10, col).Value = "" Then
Exit For
Set rs = db.OpenRecordse t("tblProductio nRunDetail")

Dim Eveningid As Long

With rs
.AddNew

rs(2) = ActiveSheet.Ran ge("k3").Value 'date
rs(3) = ActiveSheet.Ran ge("k4").Value 'supervisor
rs(4) = ActiveSheet.Ran ge("h3").Value ' shift
rs(5) = ActiveSheet.Ran ge("h4").Value ' time
rs(6) = Worksheets("Eve ning Shift Report").Cells( 10, col).Value
'product
rs(7) = Worksheets("Eve ning Shift Report").Cells( 14, col).Value '
good
rs(8) = Worksheets("Eve ning Shift Report").Cells( 64, col).Value '
bad
rs(9) = Worksheets("Eve ning Shift Report").Cells( 24, col).Value '
dryWt
rs(10) = Worksheets("Eve ning Shift Report").Cells( 23, col).Value '
wetwt
rs(11) = Worksheets("Eve ning Shift Report").Cells( 27, col).Value '
wttest
rs(12) = Worksheets("Eve ning 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\Produc tionData_tables .MDB")
Set rs = db.OpenRecordse t("tblProductio nRunRejects")
For row = 44 To 63 Step 1
If Worksheets("Eve ning Shift Report").Cells( row, col).Value = "" Then
Exit For
rs.AddNew
rs(1) = Eveningid
rs(2) = Worksheets("Eve ning Shift Report").Cells( row, col).Value
rs(3) = Worksheets("Eve ning Shift Report").Cells( row, col + 1).Value
rs.Update
Next row
rs.Close

' Downtime-----------------------------------------------------------
Set db = OpenDatabase("S :\Production
Database\Produc tionData_tables .MDB")
Set rs = db.OpenRecordse t("tblProductio nRunDownTime")
For row = 37 To 39 Step 1
If Worksheets("Eve ning Shift Report").Cells( row, col).Value = "" Then
Exit For
rs.AddNew
rs(1) = Eveningid
rs(2) = Worksheets("Eve ning Shift Report").Cells( row, col).Value
rs(3) = Worksheets("Eve ning Shift Report").Cells( row, col + 1).Value
rs.Update
Next row
rs.Close
Next col


End Sub