PDA

View Full Version : For Next Loop problems


talytech
02-05-2009, 08:19 AM
I have a huge problem that I can't seem to figure out. I hope I can explain this well. Here goes....

I have two user forms named CSSProcessing and frmLstBox.

On [CSSProcessing], I have a button called "Update" and behind my button is a For Next Loop that loops through the rows on my spreadsheet and checks to see if the data in the cells (which make up one record) already exist in a database that I'm connected to. If the record exists then I show that record in a listbox that's on [frmLstBox]. I setup the listbox values within the For Next Loop then I show [frmLstBox] with the record in the listbox. That seems to work fine.

But my problem is after I open the [frmListBox] and perform whatever action I am going to do, I need to transfer back to the For Next Loop on the [CSSProcessing] to check for the next row.

My question is .. how do I get it to transfer back to the for next loop or is that even possible?

Here is my code on [CSSProcessing] where I set up the listbox that's on [frmLstBox]... Please can somebody tell me what I'm doing wrong.



'CHECK FOR BI RECORD IN CONTRACTORS BI DATABASE

sqlBIRec = "SELECT tblContractorDataOnly.Id, tblContractorDataOnly.LName, tblContractorDataOnly.FName, tblContractorDataOnly.DOB, Right([tblContractorDataOnly].[Social Security],4) AS SSN, tblContractorDataOnly.Company, Format([tblcontractorDataOnly].[Restricted],'Yes/No') AS Restricted, tblBackgoundReview.BIStatus, tblBackgoundReview.BICompleted " _
& "FROM tblContractorDataOnly INNER JOIN tblBackgoundReview ON tblContractorDataOnly.Id = tblBackgoundReview.Data_ID " _
& "WHERE (((tblContractorDataOnly.LName) = '" & ctrlname & "') And ((tblContractorDataOnly.FName) = '" & ctrfname & "') or ((tblContractorDataOnly.DOB) = #" & ctrDOB & "#) And ((Right([tblContractorDataOnly].[Social Security], 4)) = " & ctrSSN & ")) " _
& "ORDER BY tblBackgoundReview.BICompleted DESC;"

Set rstBIContractors = dbsContractorsBI.OpenRecordset(sqlBIRec, dbOpenDynaset)
If rstBIContractors.BOF = True Then
'ADD RECORD TO EXCEPTION DATABASE
qdfNewStr = "INSERT INTO tblExceptions ( FName, LName, Mid, Last4_SSN, DOB, Vendor, chkAFM, chkNPI, chkCD, chkFR, RequestDate, HiringMgr_FName, HiringMgr_Mid, HiringMgr_LName, HiringMgr_userId, Approver_Fname, Approver_Mid, Approver_Lname, Approver_UID, WorkType, BIStatus, Status, DBUpdatedBy, CSO_approver, CSO_Date_approved, DBUpdated, ExceptionApproved ) " _
& "SELECT '" & ctrfname & "' AS Expr1, '" & ctrlname & "' AS Expr2, '" & ctrmid & "' AS Expr3, '" & ctrSSN & "' AS Expr4, #" & ctrDOB & "# AS Expr5, '" & ctrVendor & "' AS Expr6, '" & varchkAFM & "' AS Expr7, '" & varchkNPI & "' AS Expr8, '" & varchkCD & "' AS Expr9, '" & varchkFR & "' AS Expr10, #" & rqstDate & "# AS Expr11, '" & mgrFname & "' AS Expr12, '" & mgrMid & "' AS Expr13, '" & mgrLname & "' AS Expr14, '" & mgruserid & "' AS Expr15, '" & vpFname & "' AS Expr16, '" & vpMid & "' AS Expr17, '" & vpLname & "' AS Expr18, '" & vpUserID & "' AS Expr19, 'Contractor' AS Expr20, 'PENDING-BI CHK' AS Expr21, 'Active' AS Expr22, '" & csoApprover & "' AS Expr23, '" & csoApprover & "' AS Expr24, '" & csoDateApproved & "' AS Expr25, Date() AS Expr26, '" & exceptionAnswer & "' AS Expr27;"
dbsExceptions.Execute qdfNewStr

'GET EXCEPTION ID
rstException.MoveLast
rstException.Index = "UniqueID"
rstException.Seek "=", ctrSSN, ctrDOB
getExceptID = rstException![Ex_RequestID]


'ADD BI RECORD IN CONTRACTORS BI DATABASE
wktype = "RGL"
wkstatus = "Active"
dstore = "CSO"
pkey = Right(ctrSSN, 3) & Format(ctrDOB, "mmdd") & Left(ctrlname, 2)
qdfBIrec = "INSERT INTO tblContractorDataOnly ( FName, LName, Mid, WorkType, Company, [Social Security], DOB, Status, created, createdby, data_store, uniqueID )SELECT '" & ctrfname & "' AS Expr1, '" & ctrlname & "' AS Expr2, '" & ctrmid & "' AS Expr3, '" & wktype & "' AS Expr4, '" & ctrVendor & "' AS Expr16, '" & ctrSSN & "' AS Expr17, '" & ctrDOB & "' AS Expr18, '" & wkstatus & "' AS Expr5, '" & csoDateApproved & "' AS Expr6, '" & csoApprover & "' AS Expr7, '" & dstore & "' AS Expr9, '" & pkey & "' AS Expr10;"
dbsContractorsBI.Execute qdfBIrec
DoEvents
updBIrec = "INSERT INTO tblBackgoundReview ( Data_ID, Recvd_S85, Recvd_S86, Results, Recvd_Drug_screen, S85_comments, S86_comments, results_comments, drugscreen_comments, LastUpdated, LastUpdatedBy, BIStatus, ExceptionStatus, ExceptionCompleted, ExceptionID ) " _
& "SELECT tblContractorDataOnly.Id, 'NONE' AS s85stat, 'NONE' AS s86stat, 'NONE' AS resultstau, 'NONE' AS drugsceenstat, 'MISSING S85' AS s85comment, 'MISSING S86' AS S86comment, 'MISSING BACKGROUND INVESTIGATION' AS resultcomment, 'MISSING DRUG SCREEN' AS drugscreencomment, Date() AS lastUpdated, '" & csoDateApproved & "' AS LastUpdatedby, 'PENDING-BI CHK' AS Bistatus, '" & exceptionAnswer & "' AS ExcStat, Date() AS ExcComplete, '" & getExceptID & "' AS ExcID FROM tblContractorDataOnly WHERE (((tblContractorDataOnly.UniqueID)='" & pkey & "'));"
dbsContractorsBI.Execute updBIrec


Else 'if BI Record found
'SETUP UserForm lstBox ListBox values

lstBox![ExistingName].Value = "A BI record may already exist for " & ctrfname & " " & ctrlname & ". Please check the names below to verify."

lstboxSql = "SELECT tblContractorDataOnly.Id, tblContractorDataOnly.FName, tblContractorDataOnly.LName, tblContractorDataOnly.DOB, Right([tblContractorDataOnly].[Social Security],4) AS SSN, tblContractorDataOnly.[Company], tblContractorDataOnly.[Data_Store], tblContractorDataOnly.[Status], Format([tblContractorDataOnly].[Restricted],'Yes/No') AS Restricted, tblBackgoundReview.BIStatus, tblBackgoundReview.BICompleted, tblBackgoundReview.ExceptionStatus " _
& "FROM tblContractorDataOnly INNER JOIN tblBackgoundReview ON tblContractorDataOnly.Id = tblBackgoundReview.Data_ID WHERE (((tblContractorDataOnly.FName)='" & ctrfname & "') AND ((tblContractorDataOnly.LName)='" & ctrlname & "')) OR (((tblContractorDataOnly.DOB)=#" & ctrDOB & "#) AND ((Right([tblContractorDataOnly].[Social Security],4))=" & ctrSSN & ")) ORDER BY tblBackgoundReview.BICompleted DESC;"



Set lstboxRst = dbsContractorsBI.OpenRecordset(lstboxSql, dbOpenDynaset)



lstBox!ListBox1.ColumnCount = lstboxRst.Fields.Count
For Each f In lstboxRst.Fields
myArray(0, myCounter) = f.Name
myCounter = myCounter + 1
Next

lstboxRst.MoveLast
lstboxRst.MoveFirst
myCounter = 1
Do
myArray(myCounter, 0) = lstboxRst![ID]
myArray(myCounter, 1) = lstboxRst![FName]
myArray(myCounter, 2) = lstboxRst![LName]
myArray(myCounter, 3) = lstboxRst![DOB]
myArray(myCounter, 4) = lstboxRst![SSN]
myArray(myCounter, 5) = lstboxRst![Company]
myArray(myCounter, 6) = lstboxRst![Data_Store]
myArray(myCounter, 7) = lstboxRst![Status]
myArray(myCounter, 7) = lstboxRst![Restricted]
myArray(myCounter, 8) = lstboxRst![BIStatus]
myArray(myCounter, 9) = lstboxRst![bicompleted]
myArray(myCounter, 10) = lstboxRst![ExceptionStatus]
lstboxRst.MoveNext
myCounter = myCounter + 1
Loop Until lstboxRst.EOF = True
lstBox!ListBox1.List() = myArray


'lstboxRst.Close
'dbsContractor.Close
'Set lstboxRst = Nothing
'Set dbsContractor = Nothing

lstBox.Show

End If
nst1107
02-05-2009, 09:03 AM
I see only one For...Next loop in your code, and, from reading your post, I don't think that is the loop you are referring to. Do you mean the Do...Loop Until loop?

Try putting the lines to fill your listbox and show frmListBox inside the loop. Execution will pass to frmListBox once it hits the line "frmListBox.Show" and will return to the next line in the loop once frmListBox is closed.
talytech
02-05-2009, 11:20 AM
You're right.. I didn't include the first part of the code. I've included it all... it's a lot.

But The Else part
Else 'if BI Record found this is what I want to do.. If the row of data matches a record in my database then I want to display a listbox of that data from the database. The end user will have three options they can choose to do by clicking 1 of three buttons of the Userform that displays the listbox. After they perform whatever action they choose for that specific row, then the userform with the listbox should unload and the code should go back to the next row. Here is all of the code:


'Open Microsoft Jet and ODBCDirect workspaces, Microsoft
'Jet database, and ODBCDirect connection.
Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
Set dbsExceptions = wrkJet.OpenDatabase("M:\TODAYS_SERVER\Exceptions_Db.mdb")
Set rstException = dbsExceptions.OpenRecordset("tblExceptions", dbOpenTable)
Set dbsContractorsBI = wrkJet.OpenDatabase("M:\TODAYS_SERVER\Contractor_BE.mdb")
lastrow = Cells(Rows.Count, "b").End(xlUp).Row
'CHECK FOR Exception record
For I = 20 To lastrow
'Get Fields
rqstDate = Worksheets("Sheet1").Range("c10").Value
mgrFname = Worksheets("Sheet1").Range("c11").Value
mgrLname = Worksheets("Sheet1").Range("g11").Value
mgrMid = Worksheets("Sheet1").Range("f11").Value
mgruserid = Worksheets("Sheet1").Range("j11").Value
vpFname = Worksheets("Sheet1").Range("c13").Value
vpLname = Worksheets("Sheet1").Range("g13").Value
vpMid = Worksheets("Sheet1").Range("f13").Value
vpUserID = Worksheets("Sheet1").Range("j13").Value

ctrfname = Cells(I, "b").Value
ctrlname = Cells(I, "f").Value
ctrmid = Cells(I, "e").Value
ctrSSN = Cells(I, "i").Value
ctrDOB = Cells(I, "j").Value
ctrVendor = Cells(I, "k").Value

If Cells(I, "m").Value = "Y" Then
varchkNPI = "-1"
ElseIf Cells(I, "m").Value = "N" Then
varchkNPI = "0"
End If
If Cells(I, "n").Value = "Y" Then
varchkCD = "-1"
ElseIf Cells(I, "n").Value = "N" Then
varchkCD = "0"
End If
If Cells(I, "o").Value = "Y" Then
varchkFR = "-1"
ElseIf Cells(I, "o").Value = "N" Then
varchkFR = "0"
End If
If Cells(I, "l").Value = "Y" Then
varchkAFM = "-1"
ElseIf Cells(I, "l").Value = "N" Then
varchkAFM = "0"
End If

csoDateApproved = [txtDate]
csoApprover = [txtUser]

If [chkAccepted].Value = True Then
exceptionAnswer = "ACCEPTED"
ElseIf [chkDenied].Value = True Then
exceptionAnswer = "REJECTED"
End If


'-------------------------------------------------------------------------------
rstException.MoveLast
rstException.Index = "UniqueID"
rstException.Seek "=", ctrSSN, ctrDOB
If rstException.NoMatch Then
'CHECK FOR BI RECORD IN CONTRACTORS BI DATABASE

sqlBIRec = "SELECT tblContractorDataOnly.Id, tblContractorDataOnly.LName, tblContractorDataOnly.FName, tblContractorDataOnly.DOB, Right([tblContractorDataOnly].[Social Security],4) AS SSN, tblContractorDataOnly.Company, Format([tblcontractorDataOnly].[Restricted],'Yes/No') AS Restricted, tblBackgoundReview.BIStatus, tblBackgoundReview.BICompleted " _
& "FROM tblContractorDataOnly INNER JOIN tblBackgoundReview ON tblContractorDataOnly.Id = tblBackgoundReview.Data_ID " _
& "WHERE (((tblContractorDataOnly.LName) = '" & ctrlname & "') And ((tblContractorDataOnly.FName) = '" & ctrfname & "') or ((tblContractorDataOnly.DOB) = #" & ctrDOB & "#) And ((Right([tblContractorDataOnly].[Social Security], 4)) = " & ctrSSN & ")) " _
& "ORDER BY tblBackgoundReview.BICompleted DESC;"

Set rstBIContractors = dbsContractorsBI.OpenRecordset(sqlBIRec, dbOpenDynaset)
If rstBIContractors.BOF = True Then
'ADD RECORD TO EXCEPTION DATABASE
qdfNewStr = "INSERT INTO tblExceptions ( FName, LName, Mid, Last4_SSN, DOB, Vendor, chkAFM, chkNPI, chkCD, chkFR, RequestDate, HiringMgr_FName, HiringMgr_Mid, HiringMgr_LName, HiringMgr_userId, Approver_Fname, Approver_Mid, Approver_Lname, Approver_UID, WorkType, BIStatus, Status, DBUpdatedBy, CSO_approver, CSO_Date_approved, DBUpdated, ExceptionApproved ) " _
& "SELECT '" & ctrfname & "' AS Expr1, '" & ctrlname & "' AS Expr2, '" & ctrmid & "' AS Expr3, '" & ctrSSN & "' AS Expr4, #" & ctrDOB & "# AS Expr5, '" & ctrVendor & "' AS Expr6, '" & varchkAFM & "' AS Expr7, '" & varchkNPI & "' AS Expr8, '" & varchkCD & "' AS Expr9, '" & varchkFR & "' AS Expr10, #" & rqstDate & "# AS Expr11, '" & mgrFname & "' AS Expr12, '" & mgrMid & "' AS Expr13, '" & mgrLname & "' AS Expr14, '" & mgruserid & "' AS Expr15, '" & vpFname & "' AS Expr16, '" & vpMid & "' AS Expr17, '" & vpLname & "' AS Expr18, '" & vpUserID & "' AS Expr19, 'Contractor' AS Expr20, 'PENDING-BI CHK' AS Expr21, 'Active' AS Expr22, '" & csoApprover & "' AS Expr23, '" & csoApprover & "' AS Expr24, '" & csoDateApproved & "' AS Expr25, Date() AS Expr26, '" & exceptionAnswer & "' AS Expr27;"
dbsExceptions.Execute qdfNewStr

'GET EXCEPTION ID
rstException.MoveLast
rstException.Index = "UniqueID"
rstException.Seek "=", ctrSSN, ctrDOB
getExceptID = rstException![Ex_RequestID]


'ADD BI RECORD IN CONTRACTORS BI DATABASE
wktype = "RGL"
wkstatus = "Active"
dstore = "CSO"
pkey = Right(ctrSSN, 3) & Format(ctrDOB, "mmdd") & Left(ctrlname, 2)
qdfBIrec = "INSERT INTO tblContractorDataOnly ( FName, LName, Mid, WorkType, Company, [Social Security], DOB, Status, created, createdby, data_store, uniqueID )SELECT '" & ctrfname & "' AS Expr1, '" & ctrlname & "' AS Expr2, '" & ctrmid & "' AS Expr3, '" & wktype & "' AS Expr4, '" & ctrVendor & "' AS Expr16, '" & ctrSSN & "' AS Expr17, '" & ctrDOB & "' AS Expr18, '" & wkstatus & "' AS Expr5, '" & csoDateApproved & "' AS Expr6, '" & csoApprover & "' AS Expr7, '" & dstore & "' AS Expr9, '" & pkey & "' AS Expr10;"
dbsContractorsBI.Execute qdfBIrec
DoEvents
updBIrec = "INSERT INTO tblBackgoundReview ( Data_ID, Recvd_S85, Recvd_S86, Results, Recvd_Drug_screen, S85_comments, S86_comments, results_comments, drugscreen_comments, LastUpdated, LastUpdatedBy, BIStatus, ExceptionStatus, ExceptionCompleted, ExceptionID ) " _
& "SELECT tblContractorDataOnly.Id, 'NONE' AS s85stat, 'NONE' AS s86stat, 'NONE' AS resultstau, 'NONE' AS drugsceenstat, 'MISSING S85' AS s85comment, 'MISSING S86' AS S86comment, 'MISSING BACKGROUND INVESTIGATION' AS resultcomment, 'MISSING DRUG SCREEN' AS drugscreencomment, Date() AS lastUpdated, '" & csoDateApproved & "' AS LastUpdatedby, 'PENDING-BI CHK' AS Bistatus, '" & exceptionAnswer & "' AS ExcStat, Date() AS ExcComplete, '" & getExceptID & "' AS ExcID FROM tblContractorDataOnly WHERE (((tblContractorDataOnly.UniqueID)='" & pkey & "'));"
dbsContractorsBI.Execute updBIrec

Else 'if BI Record found
'SETUP UserForm lstBox ListBox values

lstBox![ExistingName].Value = "A BI record may already exist for " & ctrfname & " " & ctrlname & ". Please check the names below to verify."

lstboxSql = "SELECT tblContractorDataOnly.Id, tblContractorDataOnly.FName, tblContractorDataOnly.LName, tblContractorDataOnly.DOB, Right([tblContractorDataOnly].[Social Security],4) AS SSN, tblContractorDataOnly.[Company], tblContractorDataOnly.[Data_Store], tblContractorDataOnly.[Status], Format([tblContractorDataOnly].[Restricted],'Yes/No') AS Restricted, tblBackgoundReview.BIStatus, tblBackgoundReview.BICompleted, tblBackgoundReview.ExceptionStatus " _
& "FROM tblContractorDataOnly INNER JOIN tblBackgoundReview ON tblContractorDataOnly.Id = tblBackgoundReview.Data_ID WHERE (((tblContractorDataOnly.FName)='" & ctrfname & "') AND ((tblContractorDataOnly.LName)='" & ctrlname & "')) OR (((tblContractorDataOnly.DOB)=#" & ctrDOB & "#) AND ((Right([tblContractorDataOnly].[Social Security],4))=" & ctrSSN & ")) ORDER BY tblBackgoundReview.BICompleted DESC;"



Set lstboxRst = dbsContractorsBI.OpenRecordset(lstboxSql, dbOpenDynaset)



lstBox!ListBox1.ColumnCount = lstboxRst.Fields.Count
For Each f In lstboxRst.Fields
myArray(0, myCounter) = f.Name
myCounter = myCounter + 1
Next

lstboxRst.MoveLast
lstboxRst.MoveFirst
myCounter = 1
Do
myArray(myCounter, 0) = lstboxRst![ID]
myArray(myCounter, 1) = lstboxRst![FName]
myArray(myCounter, 2) = lstboxRst![LName]
myArray(myCounter, 3) = lstboxRst![DOB]
myArray(myCounter, 4) = lstboxRst![SSN]
myArray(myCounter, 5) = lstboxRst![Company]
myArray(myCounter, 6) = lstboxRst![Data_Store]
myArray(myCounter, 7) = lstboxRst![Status]
myArray(myCounter, 7) = lstboxRst![Restricted]
myArray(myCounter, 8) = lstboxRst![BIStatus]
myArray(myCounter, 9) = lstboxRst![bicompleted]
myArray(myCounter, 10) = lstboxRst![ExceptionStatus]
lstboxRst.MoveNext
myCounter = myCounter + 1
Loop Until lstboxRst.EOF = True
lstBox!ListBox1.List() = myArray


'lstboxRst.Close
'dbsContractor.Close
'Set lstboxRst = Nothing
'Set dbsContractor = Nothing

lstBox.Show

End If


Else 'if Exception already exists

results = MsgBox("AN EXCEPTION REQUEST ALREADY EXISTS FOR THIS SSN AND DOB." & Chr(13) & Chr(13) & "Do you want to send an exception notice?", vbExclamation + vbYesNo, "Duplicate Request")
If results = vbYes Then
SendNotice
'MsgBox "send email"
'Exit Sub
Else
End If
End If

'''' wrkJet.Close
Next I
nst1107
02-06-2009, 07:09 AM
Look at this:Option Explicit
Sub example1()
Dim i As Integer
Stop
'Here's a few lines of code inside a loop.
For i = 1 To 2
Debug.Print i
Debug.Print Date
'Now let's show a userform.
If i = 2 Then
UserForm1.Show
'The code won't proceed to the next line until the userform has been closed.
Debug.Print "See how that works?"
End If
Next
End Sub

The easiest way to get your code to resume execution inside your loop once frmListBox is closed is to place the line "frmListBox.Show" inside your loop. A more difficult way would be to use a GoTo statement. Take a look at this:Sub example2()
Dim i As Integer
Stop
'Here's a few lines of code inside a loop.
For i = 1 To 2
lineLable:
Debug.Print i
Debug.Print Date
Next
'Now let's show a userform.
UserForm1.Show
'Now let's go back inside the loop.
If i < 3 Then GoTo lineLable
End Sub
talytech
02-17-2009, 08:24 AM
I'm still trying to get this to work. So far the code you gave me isn't working. This seems to be very complex. I just want to be able to transfer control back to a procedure on another form. On Userform-A ... within my loop... I ask to show Userform-B that has a listbox. After I click a button on that Userform-B it closes out and it doesn't take me to the "next" line in my loop on Userform-A. I don't know why it just assumes that's it. Somebody please help me.
nst1107
02-17-2009, 09:27 AM
Unless I is equal to lastrow whenever Userform-B is shown, or Userform-B has an End statement, I don't know why it wouldn't go to the next line, either. Try stepping through your code and see where exactly it ends.