For Next Loop problems

[talytech]

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]

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]

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]

Look at this:[vba]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

[/vba]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:[vba]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
[/vba]

[talytech]

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]

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.