stumped: For- Next Code doesn't work?

A

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 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
 
A

AR Hall

A more recent version of my code works but not every time. Here it is:

Sub NightShift()

Dim db As database
Dim rs As Recordset
Dim headerid As Long


Dim strSheet As String


Sheets("Night Shift Report").Select
strSheet = "Night Shift Report"

Dim col As Integer
Dim row As Integer
Dim inc As Integer
Dim prodcode As Long

For col = 2 To 17 Step 3

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

Set db = OpenDatabase("C:\Production
Database\ProductionData_tables.MDB")

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("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

'Unused Code #16 .. see bottom of code sheet

rs.Update
rs.MoveLast
headerid = rs(0)

End With




'Rejects-------------------------------------------------------------

Set db = OpenDatabase("C:\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
With rs
.addnew
rs(1) = headerid
rs(2) = Worksheets("Night Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Night Shift Report").Cells(row, col + 1).Value
rs.Update
End With
Next row
'rs.Close

' Downtime-----------------------------------------------------------
Set db = OpenDatabase("C:\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
With rs
.addnew
rs(1) = headerid
rs(2) = Worksheets("Night Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Night Shift Report").Cells(row, col + 1).Value
rs.Update
End With
Next row
'rs.Close
Next col

rs.Close
End Sub

Public Sub DayShift()
Dim db As database
Dim rs As Recordset
Dim headerid As Long


Dim strSheet As String
Dim actworkbook As Workbook
Set actworkbook = ThisWorkbook

Sheets("Day Shift Report").Select
strSheet = "Day Shift Report"

Dim col As Integer
Dim row As Integer
Dim inc As Integer

Dim prodcode As Long
For col = 2 To 17 Step 3


Set db = OpenDatabase("C:\Production
Database\ProductionData_tables.MDB")
Set rs = db.OpenRecordset("tblProductionRunDetail")






If Worksheets("Day Shift Report").Cells(10, col).Value = "" Then Exit
For
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

'Unused Code #16 .. see bottom of code sheet

rs.Update
rs.MoveLast
headerid = rs(0)

End With




'Rejects-------------------------------------------------------------

Set db = OpenDatabase("C:\Production
Database\ProductionData_tables.MDB")
Set rs = db.OpenRecordset("tblProductionRunRejects")
For row = 44 To 63 Step 1
If Worksheets("Day Shift Report").Cells(row, col).Value = "" Then
Exit For
With rs
.addnew
rs(1) = headerid
rs(2) = Worksheets("Day Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Day Shift Report").Cells(row, col + 1).Value
rs.Update
End With
Next row
'rs.Close

' Downtime-----------------------------------------------------------
Set db = OpenDatabase("C:\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
With rs
.addnew
rs(1) = headerid
rs(2) = Worksheets("Day Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Day Shift Report").Cells(row, col + 1).Value
rs.Update
End With
Next row
'rs.Close
Next col

rs.Close
End Sub

Public Sub EveningShift()
Dim db As database
Dim rs As Recordset
Dim headerid As Long


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
Dim prodcode As Long

For col = 2 To 17 Step 3

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

Set db = OpenDatabase("C:\Production
Database\ProductionData_tables.MDB")
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("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

'Unused Code #16 .. see bottom of code sheet

rs.Update
rs.MoveLast
headerid = rs(0)

End With




'Rejects-------------------------------------------------------------

Set db = OpenDatabase("C:\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
With rs
.addnew
rs(1) = headerid
rs(2) = Worksheets("Evening Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Evening Shift Report").Cells(row, col + 1).Value
rs.Update
End With
Next row
'rs.Close

' Downtime-----------------------------------------------------------
Set db = OpenDatabase("C:\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
With rs
.addnew
rs(1) = headerid
rs(2) = Worksheets("Evening Shift Report").Cells(row, col).Value
rs(3) = Worksheets("Evening Shift Report").Cells(row, col + 1).Value
rs.Update
End With
Next row
'rs.Close
Next col

rs.Close
End Sub

Public Sub dBSAVE()
DayShift
EveningShift
NightShift
End Sub
 
M

Mark E. Philpot

Put the declarations (Dim) before any code. it seems to
prefer it this way.

You may have missed some lines in the code or maybe this
is it?
You have an IF statement but I cannot find the "End If".

you have en Exit For but no "Else" if not an Else use and
End IF. The other statements refer if the statement is
false.
If Worksheets("Night Shift Report").Cells(10, col).Value
= "" Then
Exit For
ELSE
other statements
End If

If this =that then
exit for
end if

If this=that then
exit for
else
......
.....
end if

If I have got it wrong then
Doh!
End if

Also, with Access, you may have to set the Primary Key.

regards
Mark
 
A

AR Hall

thanks Mark.

I thought of the end if but when I put it in I got an error: "For without
Next", I believe it was.
now that I think of it that doesn't make sense to me. There are several
nested For Next statements. The one main one is for the columns in the
sheet to get the main work order data, then the nested for next's for rows
to get the reject and downtime for each work order.
 
C

Chip Pearson

If you are getting an error "For without Next", you are missing
some sort of End statement, e.g., End If, End Select, Loop, etc.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Multi Select List Box in Access 0
Select first empty row in a column 9
missing object error 2
VB Macro Problem 1
MACRO COLUMNS, SKIP ROWS 6
MS Access setting outlook reminders from a DAO recordset 0
Excel How to capture data to a specified excel sheet(first workbook) of two different workbooks from the 0
Excel How to connect to database through Macro Excel in MAC 0

Top