LoopWithout Do Error- Plz help

D

dkc123

Registered User.
Local time
Yesterday, 17:19
Joined
Mar 21, 2012
Messages
17
Hi Friends,

Got stuck up with Error LoopwithoutDo- But I do have the Do ....
Also checked for misssing End If's again and again; they are all there..
Following is the code, had a working code with subloops which were working perfect, but then I tried to put those in Loop- so that the query would run over each of the selected test names to delete them, but with the addition of this (rs) getting Loop without Do error,
Plz help-Checked tried everything but only got a headache till yet,

Thanks to all of you in advance.....

================>
Code: 
'===========================>>>>>
strfrm = "TestBookingUnboundB"
DoCmd.SetWarnings (WarningsOff)

strreg = Form_TestBookingUnboundB.RegistrationID

Set db = CurrentDb

strtoid = Form_TestBookingUnboundB.txttoid

strtid = strtoid

'strtnid = Me.txtTID
'==========================>>>>>
        Set rs = db.OpenRecordset("Select * From TempTestSelectorTbl Where ChkSelect=-1")
        Me.Requery
        With rs
        rs.MoveFirst
        Do
        strTestName = rs("TestName")
        strtnid = strTestName
        
If DLookup("ReportCat", "TestName", "TestNameID= " & strTestName & " ") = 22 Then
        DoCmd.RunSQL ("Delete * FROM CultureReport WHERE TestOrderID = " & strtoid & ")")
        End If
        If DLookup("NonValue", "TestName", " TestNameID =" & strTestName & "") = 0 Then
        'C1
        DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE TestName= " & strTestName & " AND TestOrderID=" & strtoid & "")
        DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & strTestName & "")
        '====21/8/17===>Enter payment and repaint the TBUB form============>
'==Check if payent has been made , then enter the value in payments tbl=======
            If IsNull(Form_TestBookingUnboundB.txtPayment) = False Then
                    strpymnt = Form_TestBookingUnboundB.txtPayment
                    Set rspymnt = db.OpenRecordset("Payments")
                    rspymnt.AddNew
                    rspymnt("PaymentRefID").Value = strtoid
                    rspymnt("AmountPaid").Value = strpymnt
                    rspymnt("PaymentDept").Value = Form_TestBookingUnboundB.txtprefixid
                    rspymnt("RegistrationID").Value = Form_TestBookingUnboundB.RegistrationID
                    rspymnt("PaymentMode").Value = Form_TestBookingUnboundB.txtPaymentMode
                    rspymnt.Update
            End If
            '==Check if payent has been made , then enter the value in payments tbl=======END====
        Me.Requery
                DoCmd.SetWarnings (WarningsOn)
                
                Form_TestReviewUnboundB.RecordSource = ("SELECT TestName, TestCost, TestOrderID, BookedTest FROM NonProfileTests WHERE ((TestOrderID = " & strtoid & ") AND (BookedTest= -1))")
                Form_TestBookingUnboundB.txtAmount = DSum("TestCost", "NonProfileTests", "TestOrderID = " & strtoid & " ")
                Form_TestBookingUnboundB.txttoid = strtoid
                Form_TestBookingUnboundB.txttoid.Visible = True
                DoCmd.SetWarnings (WarningsOn)
                '------------copied code-----------
                strtotalamnt = Nz(DSum("TestCost", "NonProfileTests", "TestOrderID = " & strtoid & " "), 0)
                strtotalpaid = Nz(DSum("AmountPaid", "Payments", "PaymentRefID = " & strtoid & " "), 0)
                strdscnt = Nz(DLookup("BkDscnt", "BkOrdrTbl", "BkOrdrTblID = " & strtoid & ""), 0)
                '=================
                Form_TestBookingUnboundB.txtAmount = strtotalamnt
                Form_TestBookingUnboundB.txtTotalPayable = (strtotalamnt - strdscnt) - strtotalpaid
                Form_TestBookingUnboundB.txtTotalPaid = strtotalpaid
                Form_TestBookingUnboundB.txtPayment = 0
                '-------------------------------
                DoCmd.SetWarnings (WarningsOn)
                
               
'======If the tests selected fordeletion was not a profile then complete following actions>>>>>
Exit Sub
End If ' C1
'===If the test is not a profile delete & Exit Recalculate form TBUE =<<<<<<
'==========================<<<<<
'DEPTH I=>>>
            '---If Its a Culture test then add to culture form---------
'DEPTH I=>>>                DoCmd.RunSQL ("Delete * FROM CultureReport WHERE TestOrderID= " & strtoid & "")
                'DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & strtnid & "")
               'End If
            '-------x------Add to culture report code ends here----------x---x-----x---------------------------
'DEPTH I=>>>'--Check if its a Profile----------------

If DLookup("NonValue", "TestName", " TestNameID =" & strtnid & "") = -1 Then
 '==========Get individual profile tests using ProfileDetailTbl and sort them====16/8/17===
'DEPTH I=>>>
'        Set rstn = mydb.OpenRecordset("SELECT Inprofile.value FROM TestName WHERE TestNameID = " & strtnid & " ", dbOpenDynaset)
        Set rstn = mydb.OpenRecordset("SELECT * FROM ProfileDetailTbl WHERE ProfileName = " & strtnid & " ", dbOpenDynaset)

        Set rsnpt = mydb.OpenRecordset("SELECT TestName FROM NonProfileTests WHERE TestOrderID = " & strtoid & " ")

            '---------------Loop through all the individual tests of a profile (Inprofile.value)-------------

                With rstnRecordset
'DEPTH I=>>>
                    rstn.MoveFirst
      
                    Do
                    rsnpt.FindFirst "TestName=" & rstn("InProfileTest") & ""
                    Debug.Print rstn("InProfileTest")
                    'rsnpt.Delete
                    'DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rstn("InProfileTest") & "")
                        '------IF the-added test in a profile is a culture itself then---- add to culture form----------------------
                                If DLookup("ReportCat", "TestName", "TestNameID= " & rsnpt("TestName") & " ") = 22 Then
                                DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rsnpt("TestName") & "")
                                DoCmd.RunSQL ("Delete * FROM CultureReport WHERE TestOrderID = " & strtoid & ")")
                                End If
                        
         '-------x-----InProfile added --Add to culture report code ends here----------x---x-----x---------------------------
                        '----------||-If the inserted test itself is a profile then insert related tests-||-------'" & rstn("Inprofile.value") & "'
            'DEPTH II=>>>
                                If DLookup("NonValue", "TestName", "TestNameID = " & rsnpt("TestName") & "") = -1 Then
                               
                                Set rstnsub = mydb.OpenRecordset("SELECT * FROM ProfileDetailTbl WHERE ProfileName =  " & rsnpt("TestName") & "", dbOpenDynaset)
                                With rstnsubRecordset
                                rstnsub.MoveFirst
            'DEPTH II=>>>
                                    Do
                                Set rsnpt1 = mydb.OpenRecordset("SELECT * FROM NonProfileTests WHERE TestOrderID = " & strtoid & " ")
                                If IsNull(rstnsub("InProfileTest")) = False Then
                        '--Check if the test does not already exist in NPT tbl------------
                        'DEPTH II=>>>
                                        rsnpt1.FindFirst "TestName= " & rstnsub("InProfileTest") & ""
                                        rsnpt1.Delete
                                        DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rstnsub("InProfileTest") & "")
                                        End If
                                
                        '--V-Movenext fr 3rd DO -- rstnsub-----------------
                               ' End If
                                rstnsub.MoveNext
                                Loop While Not rstnsub.EOF
                                '==Before exiting loop in DEPTH-II  delete the profile name=>>>
                                'DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE TestName= " & rsnpt("TestName") & " AND TestOrderID=" & strtoid & "")
                                'DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rsnpt("TestName") & "")
                                End With
                                rstnsub.Close
'-------------------V-Movenext fr 2nd DO -- rstn-----------------irpjil@bsraffiliates.com
           End If
            DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rsnpt("TestName") & "")
            rsnpt.Delete ' Delete test which startedtheloop
            'DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE TestName= " & rsnpt("TestName") & " AND TestOrderID=" & strtoid & "")
            rstn.MoveNext
            Loop Until rstn.EOF
            '==Before exiting loop in DEPTH-I  delete the profile name=>>>
            '
            End With
            rstn.Close
            
rs.MoveNext
Loop Until rs.EOF
End With
            DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE TestName= " & strtnid & " AND TestOrderID=" & strtoid & "")
            DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & strtnid & "")
'-------------------V-Movenext fr 1st DO -- rs-------V End If ( Check for profile------main)------------
'==Delete the TestProfile Name entries from NPT and TTSTbl
'DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE (TestOrderID = " & strtoid & " AND TestName= " & strtnid & ") ")
'DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE (TestName= " & strtnid & ") ")

'====21/8/17===>Enter payment and repaint the TBUB form============>
Set rs = Nothing
Set rsnpt = Nothing
'==Check if payent has been made , then enter the value in payments tbl=======
            If IsNull(Form_TestBookingUnboundB.txtPayment) = False Then
                    strpymnt = Form_TestBookingUnboundB.txtPayment
                    Set rspymnt = db.OpenRecordset("Payments")
                    rspymnt.AddNew
                    rspymnt("PaymentRefID").Value = strtoid
                    rspymnt("AmountPaid").Value = strpymnt
                    rspymnt("PaymentDept").Value = Form_TestBookingUnboundB.txtprefixid
                    rspymnt("RegistrationID").Value = Form_TestBookingUnboundB.RegistrationID
                    rspymnt("PaymentMode").Value = Form_TestBookingUnboundB.txtPaymentMode
                    rspymnt.Update
            End If
            '==Check if payent has been made , then enter the value in payments tbl=======END====
'=Concatenate Booked tests======>

        Me.Requery
                
                DoCmd.SetWarnings (WarningsOn)
                
                
                Form_TestReviewUnboundB.RecordSource = ("SELECT TestName, TestCost, TestOrderID, BookedTest FROM NonProfileTests WHERE ((TestOrderID = " & strtoid & ") AND (BookedTest= -1))")
                Form_TestBookingUnboundB.txtAmount = DSum("TestCost", "NonProfileTests", "TestOrderID = " & strtoid & " ")
                
                Form_TestBookingUnboundB.txttoid = strtoid
                Form_TestBookingUnboundB.txttoid.Visible = True
                DoCmd.SetWarnings (WarningsOn)
                '------------copied code-----------
                strtotalamnt = Nz(DSum("TestCost", "NonProfileTests", "TestOrderID = " & strtoid & " "), 0)
                strtotalpaid = Nz(DSum("AmountPaid", "Payments", "PaymentRefID = " & strtoid & " "), 0)
                strdscnt = Nz(DLookup("BkDscnt", "BkOrdrTbl", "BkOrdrTblID = " & strtoid & ""), 0)

                '=================
                Form_TestBookingUnboundB.txtAmount = strtotalamnt
                Form_TestBookingUnboundB.txtTotalPayable = (strtotalamnt - strdscnt) - strtotalpaid
                Form_TestBookingUnboundB.txtTotalPaid = strtotalpaid
                Form_TestBookingUnboundB.txtPayment = 0
                
                DoCmd.SetWarnings (WarningsOn)
                
                Set db = Nothing
                Set mydb = Nothing

'======If the tests selected fordeletion was not a profile then complete following actions>>>>>
Exit Sub
End If
 
But all the loops Inside are working perfect- probem has arisen only when added the first level -> rs.movefirst->Do....Otherloops are just copied and working fine...
 
Well it's quite correct, I have reformatted your code and the first Do has no end.

Also you have the line DoCmd.SetWarnings (WarningsOn) about 10 times but I can't see where you are turning the warnings off? so get rid of them. They aren't achieving anything.
The code below is indented to let you see where the problem lies.
Code: 
Private Sub flibble()
'===========================>>>>>
    strfrm = "TestBookingUnboundB"
    DoCmd.SetWarnings (WarningsOff)

    strreg = Form_TestBookingUnboundB.RegistrationID

    Set db = CurrentDb

    strtoid = Form_TestBookingUnboundB.txttoid

    strtid = strtoid

    'strtnid = Me.txtTID
    '==========================>>>>>
    Set rs = db.OpenRecordset("Select * From TempTestSelectorTbl Where ChkSelect=-1")
    Me.Requery
    With rs
        rs.MoveFirst
        Do
            strTestName = rs("TestName")
            strtnid = strTestName

            If DLookup("ReportCat", "TestName", "TestNameID= " & strTestName & " ") = 22 Then
                DoCmd.RunSQL ("Delete * FROM CultureReport WHERE TestOrderID = " & strtoid & ")")
            End If
            If DLookup("NonValue", "TestName", " TestNameID =" & strTestName & "") = 0 Then
                'C1
                DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE TestName= " & strTestName & " AND TestOrderID=" & strtoid & "")
                DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & strTestName & "")
                '====21/8/17===>Enter payment and repaint the TBUB form============>
                '==Check if payent has been made , then enter the value in payments tbl=======
                If IsNull(Form_TestBookingUnboundB.txtPayment) = False Then
                    strpymnt = Form_TestBookingUnboundB.txtPayment
                    Set rspymnt = db.OpenRecordset("Payments")
                    rspymnt.AddNew
                    rspymnt("PaymentRefID").Value = strtoid
                    rspymnt("AmountPaid").Value = strpymnt
                    rspymnt("PaymentDept").Value = Form_TestBookingUnboundB.txtprefixid
                    rspymnt("RegistrationID").Value = Form_TestBookingUnboundB.RegistrationID
                    rspymnt("PaymentMode").Value = Form_TestBookingUnboundB.txtPaymentMode
                    rspymnt.Update
                End If
                '==Check if payent has been made , then enter the value in payments tbl=======END====
                Me.Requery
                
                Form_TestReviewUnboundB.RecordSource = ("SELECT TestName, TestCost, TestOrderID, BookedTest FROM NonProfileTests WHERE ((TestOrderID = " & strtoid & ") AND (BookedTest= -1))")
                Form_TestBookingUnboundB.txtAmount = DSum("TestCost", "NonProfileTests", "TestOrderID = " & strtoid & " ")
                Form_TestBookingUnboundB.txttoid = strtoid
                Form_TestBookingUnboundB.txttoid.Visible = True
                DoCmd.SetWarnings (WarningsOn)
                '------------copied code-----------
                strtotalamnt = Nz(DSum("TestCost", "NonProfileTests", "TestOrderID = " & strtoid & " "), 0)
                strtotalpaid = Nz(DSum("AmountPaid", "Payments", "PaymentRefID = " & strtoid & " "), 0)
                strdscnt = Nz(DLookup("BkDscnt", "BkOrdrTbl", "BkOrdrTblID = " & strtoid & ""), 0)
                '=================
                Form_TestBookingUnboundB.txtAmount = strtotalamnt
                Form_TestBookingUnboundB.txtTotalPayable = (strtotalamnt - strdscnt) - strtotalpaid
                Form_TestBookingUnboundB.txtTotalPaid = strtotalpaid
                Form_TestBookingUnboundB.txtPayment = 0
                '-------------------------------
                DoCmd.SetWarnings (WarningsOn)


                '======If the tests selected fordeletion was not a profile then complete following actions>>>>>
                Exit Sub
            End If        ' C1
            '===If the test is not a profile delete & Exit Recalculate form TBUE =<<<<<<
            '==========================<<<<<
            'DEPTH I=>>>
            '---If Its a Culture test then add to culture form---------
            'DEPTH I=>>>                DoCmd.RunSQL ("Delete * FROM CultureReport WHERE TestOrderID= " & strtoid & "")
            'DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & strtnid & "")
            'End If
            '-------x------Add to culture report code ends here----------x---x-----x---------------------------
            'DEPTH I=>>>'--Check if its a Profile----------------

            If DLookup("NonValue", "TestName", " TestNameID =" & strtnid & "") = -1 Then
                '==========Get individual profile tests using ProfileDetailTbl and sort them====16/8/17===
                'DEPTH I=>>>
                '        Set rstn = mydb.OpenRecordset("SELECT Inprofile.value FROM TestName WHERE TestNameID = " & strtnid & " ", dbOpenDynaset)
                Set rstn = mydb.OpenRecordset("SELECT * FROM ProfileDetailTbl WHERE ProfileName = " & strtnid & " ", dbOpenDynaset)

                Set rsnpt = mydb.OpenRecordset("SELECT TestName FROM NonProfileTests WHERE TestOrderID = " & strtoid & " ")

                '---------------Loop through all the individual tests of a profile (Inprofile.value)-------------

                With rstnRecordset
                    'DEPTH I=>>>
                    rstn.MoveFirst

                    Do
                        rsnpt.FindFirst "TestName=" & rstn("InProfileTest") & ""
                        Debug.Print rstn("InProfileTest")
                        'rsnpt.Delete
                        'DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rstn("InProfileTest") & "")
                        '------IF the-added test in a profile is a culture itself then---- add to culture form----------------------
                        If DLookup("ReportCat", "TestName", "TestNameID= " & rsnpt("TestName") & " ") = 22 Then
                            DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rsnpt("TestName") & "")
                            DoCmd.RunSQL ("Delete * FROM CultureReport WHERE TestOrderID = " & strtoid & ")")
                        End If

                        '-------x-----InProfile added --Add to culture report code ends here----------x---x-----x---------------------------
                        '----------||-If the inserted test itself is a profile then insert related tests-||-------'" & rstn("Inprofile.value") & "'
                        'DEPTH II=>>>
                        If DLookup("NonValue", "TestName", "TestNameID = " & rsnpt("TestName") & "") = -1 Then

                            Set rstnsub = mydb.OpenRecordset("SELECT * FROM ProfileDetailTbl WHERE ProfileName =  " & rsnpt("TestName") & "", dbOpenDynaset)
                            With rstnsubRecordset
                                rstnsub.MoveFirst
                                'DEPTH II=>>>
                                Do
                                    Set rsnpt1 = mydb.OpenRecordset("SELECT * FROM NonProfileTests WHERE TestOrderID = " & strtoid & " ")
                                    If IsNull(rstnsub("InProfileTest")) = False Then
                                        '--Check if the test does not already exist in NPT tbl------------
                                        'DEPTH II=>>>
                                        rsnpt1.FindFirst "TestName= " & rstnsub("InProfileTest") & ""
                                        rsnpt1.Delete
                                        DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rstnsub("InProfileTest") & "")
                                    End If

                                    '--V-Movenext fr 3rd DO -- rstnsub-----------------
                                    ' End If
                                    rstnsub.MoveNext
                                Loop While Not rstnsub.EOF
                                '==Before exiting loop in DEPTH-II  delete the profile name=>>>
                                'DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE TestName= " & rsnpt("TestName") & " AND TestOrderID=" & strtoid & "")
                                'DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rsnpt("TestName") & "")
                            End With
                            rstnsub.Close
                            '-------------------V-Movenext fr 2nd DO -- rstn-----------------irpjil@bsraffiliates.com
                        End If
                        DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & rsnpt("TestName") & "")
                        rsnpt.Delete        ' Delete test which startedtheloop
                        'DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE TestName= " & rsnpt("TestName") & " AND TestOrderID=" & strtoid & "")
                        rstn.MoveNext
                    Loop Until rstn.EOF
                    '==Before exiting loop in DEPTH-I  delete the profile name=>>>
                    '
                End With
                rstn.Close

                rs.MoveNext
            Loop Until rs.EOF
        End With
        DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE TestName= " & strtnid & " AND TestOrderID=" & strtoid & "")
        DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE TestName= " & strtnid & "")
        '-------------------V-Movenext fr 1st DO -- rs-------V End If ( Check for profile------main)------------
        '==Delete the TestProfile Name entries from NPT and TTSTbl
        'DoCmd.RunSQL ("Delete * FROM NonProfileTests WHERE (TestOrderID = " & strtoid & " AND TestName= " & strtnid & ") ")
        'DoCmd.RunSQL ("Delete * FROM TmpTestSelectorTbl WHERE (TestName= " & strtnid & ") ")

        '====21/8/17===>Enter payment and repaint the TBUB form============>
        Set rs = Nothing
        Set rsnpt = Nothing
        '==Check if payent has been made , then enter the value in payments tbl=======
        If IsNull(Form_TestBookingUnboundB.txtPayment) = False Then
            strpymnt = Form_TestBookingUnboundB.txtPayment
            Set rspymnt = db.OpenRecordset("Payments")
            rspymnt.AddNew
            rspymnt("PaymentRefID").Value = strtoid
            rspymnt("AmountPaid").Value = strpymnt
            rspymnt("PaymentDept").Value = Form_TestBookingUnboundB.txtprefixid
            rspymnt("RegistrationID").Value = Form_TestBookingUnboundB.RegistrationID
            rspymnt("PaymentMode").Value = Form_TestBookingUnboundB.txtPaymentMode
            rspymnt.Update
        End If
        '==Check if payent has been made , then enter the value in payments tbl=======END====
        '=Concatenate Booked tests======>

        Me.Requery

        Form_TestReviewUnboundB.RecordSource = ("SELECT TestName, TestCost, TestOrderID, BookedTest FROM NonProfileTests WHERE ((TestOrderID = " & strtoid & ") AND (BookedTest= -1))")
        Form_TestBookingUnboundB.txtAmount = DSum("TestCost", "NonProfileTests", "TestOrderID = " & strtoid & " ")

        Form_TestBookingUnboundB.txttoid = strtoid
        Form_TestBookingUnboundB.txttoid.Visible = True
        DoCmd.SetWarnings (WarningsOn)
        '------------copied code-----------
        strtotalamnt = Nz(DSum("TestCost", "NonProfileTests", "TestOrderID = " & strtoid & " "), 0)
        strtotalpaid = Nz(DSum("AmountPaid", "Payments", "PaymentRefID = " & strtoid & " "), 0)
        strdscnt = Nz(DLookup("BkDscnt", "BkOrdrTbl", "BkOrdrTblID = " & strtoid & ""), 0)

        '=================
        Form_TestBookingUnboundB.txtAmount = strtotalamnt
        Form_TestBookingUnboundB.txtTotalPayable = (strtotalamnt - strdscnt) - strtotalpaid
        Form_TestBookingUnboundB.txtTotalPaid = strtotalpaid
        Form_TestBookingUnboundB.txtPayment = 0

        DoCmd.SetWarnings (WarningsOn)

        Set db = Nothing
        Set mydb = Nothing

        '======If the tests selected fordeletion was not a profile then complete following actions>>>>>
        Exit Sub
    End If

End Sub

It is much more normal to use a syntax like Do Until rs.EOF than the way you are constructing the loops.
 
Thanks a lot Minty for replying, at least there's a ray of hope..
I used Do Until rs.eof as you advised ....still same error

There are 10 warnings on because have copied lots of individual codes from different controls where they have been used...since am only developing didnt bother much..but have removed them now

The Do is closed below with loop statement..may be some other error is being complied as DO-Loop error,

Plz give some more insight....

I know this may be boring you up but wud still explain...

this is meant to delete records in a temp table which Im using to edit already booked tests...
when I use code to delete individual tests, it works fine; But what I need to do here is loop over all the tests which have been chosen ( Checked=-1)only then this Error appears.

I pasted the Code you had edited - it gives the same error but on removing

rs do loop commands the same works fine when I pass on the values of individual tests instead of the selected tests...
Plz See the attached Screen shots as well..
Thanks a lot again
 

Attachments

  • Do_Loop_Error.png
    Do_Loop_Error.png
    96.2 KB · Views: 110
  • Do_Loop_Error2.jpg
    Do_Loop_Error2.jpg
    100.3 KB · Views: 72
I suspect you could do this much easier with some sub queries rather than recordsets.
Air code but something like

Code: 
SELECT * from YourTempTable where ID in(SELECT ID From YourQuery Where Checked = -1)

If that selects the correct records then simply change it to a delete query.
 
Minty said:
...Also you have the line DoCmd.SetWarnings (WarningsOn) about 10 times...
Click to expand...
It should also be noted that

DoCmd.SetWarnings(WarningsOn)

does not set Warnings on! The WarningsOn is the Parameter for the SetWarnings command! The correct syntax would be

DoCmd.SetWarnings False

To turn warnings off, and

DoCmd.SetWarnings True

To turn warnings back on.

Linq ;0)>
 
Your End If's appear to be off.

Code: 
Private Sub flibble()
        With rs
            Do
                If DLookup("ReportCat", "TestName", "TestNameID= " & strTestName & " ") = 22 Then
                End If
                If DLookup("NonValue", "TestName", " TestNameID =" & strTestName & "") = 0 Then
                    If IsNull(Form_TestBookingUnboundB.txtPayment) = False Then
                    End If
                End If        ' C1
                If DLookup("NonValue", "TestName", " TestNameID =" & strtnid & "") = -1 Then
                    With rstnRecordset
                        Do
                            If DLookup("ReportCat", "TestName", "TestNameID= " & rsnpt("TestName") & " ") = 22 Then
                            End If
                            If DLookup("NonValue", "TestName", "TestNameID = " & rsnpt("TestName") & "") = -1 Then
                                ...
                            End If
                        Loop Until rstn.EOF
                    End With
                [B]<MISSING END IF>[/B]
            Loop Until rs.EOF
        End With
        
        If IsNull(Form_TestBookingUnboundB.txtPayment) = False Then
        End If
    End If [B]<EXTRA END IF>[/B]
End Sub
 
Thanks everyone for your replies....
Finally could resolve the problem when broke the code in indivudualbits ad tried to execute the problem was in If only, not thaat I hadnt closed any of the statements but I was using an extra If--> End If which could have been avoided.....I was individually evaluating a statement forboth true and false conditions....
That is resolved but now have another problem...tried simplifying the code by using modules which are called appropriately and passed on the values...rather than repeating the code everytime, but here I'm stuck with a new problem that whenever the module is executed and comes back to the original recordset from where it has been executed it again goes back to the first record...does not move ahead...
heres the code..
Code: 
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strtoid As String, strtnid As String
'strtoid = Me.txttoid
'strtnid = Form_TestSelectionUnboundB.TestName
Set db = CurrentDb
struser = GetUserName()
strreg = Me.RegistrationID

Set rstoid = db.OpenRecordset("SELECT BkOrdrTblID, BkDate, BkRegistrationID, BkPOG, BkDscnt,BkAmount,BkUser, BkRemarks, BkDept FROM BkOrdrTbl")

rstoid.AddNew
rstoid("BkRegistrationID").Value = strreg
rstoid("BkDate").Value = Now()
rstoid("BkPOG").Value = Me.cboPOG
rstoid("BkDscnt").Value = Nz(Me.txtDiscount, 0)
'TEMP=>>rstoid("BkUser").Value = Nz(struser, 0)
rstoid("BkRemarks").Value = Me.txtbkremarks
rstoid("BkDept").Value = Me.txtprefixid
'rstoid("BkAmnt").Value = Me.txtAmount


rstoid.Update
rstoid.Requery
rstoid.FindLast "BkRegistrationID=" & strreg & ""
strtoid = rstoid!BkOrdrTblID
rstoid.Close
'sqlnpt = ("SELECT BkOrdrTblID, TestName, TestCost, BookedTest FROM NonProfileTests")
'sqltmptbl = ("SELECT * FROM TmpTestSelectortbl")
strtid = strtoid

'----------?--------



Set rs = db.OpenRecordset("TmpTestSelectortbl")

With rs
Do Until rs.EOF
rs.MoveFirst
      DoCmd.SetWarnings False
            DoCmd.RunSQL ("Insert into NonProfileTests (TestOrderID, TestName, TestCost, BookedTest) values (" & strtoid & ", ' " & rs("TestName") & " ','" & rs("TestCost") & "', -1   )")
          
            strtnid = rs!TestName

Call SaveTestPro(strtnid, strtoid)
 
 rs.MoveNext
 Loop
 End With
 DoCmd.SetWarnings True
 
Heres the code for the Module...Its working fine...
Code: 
Option Compare Database

Public Sub SaveTestPro(strTestID As String, strbkngid As String)

'TestNameID as in the TestName table is passed on in this string(strTestID)
'BkngOrdrTblID from the BkngOrdrTbl tbl or in this case NonProfileTests tbl(strbkngid)
'This function would evaluate wether the passed string is a profile
'Then check wether it already exists in the NonProfileTests Tbl
'       If it is itself is a profile then
'           Make a recordset from the ProfileCategory Tbl which contains the constituent tests of this particular profile
'           Loop thru and insert all the constituent tests in the NonProfileTests Tbl
'
'
Dim db As DAO.Database
Dim rsst As DAO.Recordset
Dim rsnpt As DAO.Recordset
Dim rstoid As DAO.Recordset
Dim rspymnt As DAO.Recordset
Dim sqltmptbl As String
Dim sqlnpt As String
Dim sqltoid As String
Dim strreg As String
Dim struser As Variant
Dim strtestcost As Variant
Dim sql As String
Dim C As Control
'----------------code from testbookingsubbillingdata------------
Dim mydb As DAO.Database
Dim rscs As DAO.Recordset
Set mydb = CurrentDb

Dim strspecimen As String
Dim strspecimen1 As String
Dim strspecimenin As String
'Dim strTestID As String
Dim strtid As String
Dim strvid As String
Dim strvid1 As String
Dim strtvidin As String
Dim strtotalamount As String, strpymnt As String, strfrm As String, strname As String
Dim strID As String
Dim strbid As String
strfrm = "TestBookingUnboundB"
DoCmd.SetWarnings (WarningsOff)

'If Me.NonValue <> -1 Then
'Me.Requery
'--------------------------------------
struser = GetUserName()
'strreg = Me.RegistrationID

Set db = CurrentDb
strtoid = strbkngid
strtid = strbkngid
strtnid = strTestID

'If Nz(DCount("TestName", "NonProfileTests", "TestName=" & strTestID & " AND TestOrderID-" & strbkngid & ""), 0) < 1 Then 'A0
'DoCmd.RunSQL ("Insert into NonProfileTests (TestOrderID, TestName) values ('" & strbkngid & "', '" & strTestID & "')")
  

            '---If Its a Culture test then add to culture form---------
               If DLookup("ReportCat", "TestName", "TestNameID= " & strTestID & "") = 22 Then     'A1
                strvid = DLookup("TestValueID", "NonProfileTests", "TestName= " & strTestID & "AND TestOrderID= " & strbkngid & " ")
                strspecimen = DLookup("Specimen", "TestName", "TestNameID= " & strTestID & " ")
                Set rscs = mydb.OpenRecordset("CultureReport")
                DoCmd.RunSQL ("Insert into CultureReport (BkOrdrTblID, Specimen, TestValueID) values (" & strbkngid & ", " & strspecimen & " ," & strvid & " )")
               End If       '#A1
            '-------x------Add to culture report code ends here----------x---x-----x---------------------------
'--Check if its a Profile----------------
    If DLookup("NonValue", "TestName", " TestNameID =" & strTestID & "") = -1 Then        'A2
            
 '==========Get individual profile tests using ProfileDetailTbl and sort them====16/8/17===
 
        Set rstn = mydb.OpenRecordset("SELECT * FROM ProfileDetailTbl WHERE ProfileName = " & strTestID & " ", dbOpenDynaset)

        Set rsnpt = mydb.OpenRecordset("SELECT TestName FROM NonProfileTests WHERE TestOrderID = " & strbkngid & " ")

        sql = ("SELECT TestName FROM NonProfiletests WHERE TestOrderID= & strbkngid ")
            '---------------Loop through all the individual tests of a profile (Inprofile.value)-------------

                With rstnRecordset

                    rstn.MoveFirst
      
   Do
                        rsnpt.FindFirst "TestName=" & rstn("InProfileTest") & ""
                        If rsnpt.NoMatch Then       'A3
                        sqlStatement = "Insert into NonProfileTests (TestOrderID, TestName) values ('" & strbkngid & "', '" & rstn("InProfileTest") & "')"
                        DoCmd.RunSQL (sqlStatement)
                        strID = rstn("InProfileTest")
                        strbid = strbkngid
                        End If      '#A3
                        
                        strname = DLookup("TestName", "TestName", "TestNameID=" & rstn("InProfileTest") & "")
                        MsgBox "Test Name-" & strname & " has been booked", , "BOOKING INSERTED"
'===================================================================SUB ib SUB===============
                        Call SaveTestProSub(strID, strbid)
'===================================================================SUB ib SUB===============
                        '------IF the-added test in a profile is a culture itself then---- add to culture form-------------
                                 '''If DLookup("ReportCat", "TestName", "TestNameID= " & rstn("InProfileTest") & " ") = 22 Then
                                 '''strvid1 = DLookup("TestValueID", "NonProfileTests", "TestName= " & rstn("InProfileTest") & " AND TestOrderID= " & strtoid & " ")
                                 '''strspecimen1 = DLookup("Specimen", "TestName", "TestNameID= " & rstn("InProfileTest") & " ")
                                 '''Set rscs = mydb.OpenRecordset("CultureReport")
                                 '''DoCmd.RunSQL ("Insert into CultureReport (TestOrderID, Specimen, TestValueID) values (" & strtoid & ", " & strspecimen1 & " ," & strvid1 & " )")
               
                                 '''End If
                        '-------x-----InProfile added --Add to culture report code ends here----------x---x-----x---------------------------
                        '----------||-If the inserted test itself is a profile then insert related tests-||-------'" & rstn("Inprofile.value") & "'
                                 '''If DLookup("NonValue", "TestName", "TestNameID = " & rstn("InProfileTest")) = -1 Then
                                     '''Set rstnsub = mydb.OpenRecordset("SELECT * FROM ProfileDetailTbl WHERE ProfileName =  " & rstn("InProfileTest") & "", dbOpenDynaset)
                                 '''With rstnsubRecordset
                                 '''rstnsub.MoveFirst
                                    
                                    ''' Do
                                      '''       Set rsnpt1 = mydb.OpenRecordset("SELECT TestName FROM NonProfileTests WHERE TestOrderID = " & strtoid & " ")
                                     '''    If IsNull(rstnsub("InProfileTest")) = False Then
                        '--Check if the test does not already exist in NPT tbl------------
                                    '''         rsnpt1.FindFirst "TestName= " & rstnsub("InProfileTest") & ""
                                     '''        If rsnpt1.NoMatch Then
                                      '''       sqlStatementsub = "Insert into NonProfileTests (TestOrderID, TestName) values ('" & strtoid & "', '" & rstnsub("InProfileTest") & "')"
                                            '''DoCmd.RunSQL (sqlStatementsub)
                                            '''End If
                                        '''End If
                        '--V-Movenext fr 3rd DO -- rstnsub-----------------
                            'End If
                            '''rstnsub.MoveNext
                            '''Loop While Not rstnsub.EOF
                            '''End With
                            '''rstnsub.Close
'-------------------V-Movenext fr 2nd DO -- rstn-----------------
            'End If      '#A2
            
            rstn.MoveNext
            Loop Until rstn.EOF
            End With
            rstn.Close
'-------------------V-Movenext fr 1st DO -- rs-------V End If ( Check for profile------main)------------
End If      '#A2
Set rsnpt = Nothing
    
'End If      '#A0
'strname = DLookup("TestName", "TestName", "TestNameID=" & strTestID & "")
'MsgBox "Test you chose" & strname & " has already been booked", , "DUPLICATE BOOKING"
End Sub
 
I would strongly recommend you add Option Explicit to the top of ALL your code modules, then try compiling. You aren't declaring all your variables. This will lead to problems, and typo's that are hard to spot.

You can force it in new code modules in the VBA editor, under options.
attachment.php


Once you have that fixed post back the code you then have.
 

Attachments

  • RequireVariables.PNG
    RequireVariables.PNG
    14.1 KB · Views: 268
Thanks a lot Minty...You were right there were lots of undeclared variables...

buts its working fine now..heres the code..
Code: 
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rstoid As DAO.Recordset
Dim strtoid As String, strtnid As String, struser As String, strreg As String, strtid As String
'strtoid = Me.txttoid
'strtnid = Form_TestSelectionUnboundB.TestName
Set db = CurrentDb
struser = GetUserName()
strreg = Me.RegistrationID

Set rstoid = db.OpenRecordset("SELECT BkOrdrTblID, BkDate, BkRegistrationID, BkPOG, BkDscnt,BkAmount,BkUser, BkRemarks, BkDept FROM BkOrdrTbl")

rstoid.AddNew
rstoid("BkRegistrationID").Value = strreg
rstoid("BkDate").Value = Now()
rstoid("BkPOG").Value = Me.cboPOG
rstoid("BkDscnt").Value = Nz(Me.txtDiscount, 0)
'TEMP=>>rstoid("BkUser").Value = Nz(struser, 0)
rstoid("BkRemarks").Value = Me.txtbkremarks
rstoid("BkDept").Value = Me.txtprefixid
'rstoid("BkAmnt").Value = Me.txtAmount
rstoid.Update
rstoid.Requery
rstoid.FindLast "BkRegistrationID=" & strreg & ""
strtoid = rstoid!BkOrdrTblID
rstoid.Close
'sqlnpt = ("SELECT BkOrdrTblID, TestName, TestCost, BookedTest FROM NonProfileTests")
'sqltmptbl = ("SELECT * FROM TmpTestSelectortbl")
strtid = strtoid

'----------?--------



Set rs = db.OpenRecordset("TmpTestSelectortbl")

With rs

rs.MoveFirst

Do
      DoCmd.SetWarnings False
            DoCmd.RunSQL ("Insert into NonProfileTests (TestOrderID, TestName, TestCost, BookedTest) values (" & strtoid & ", ' " & rs("TestName") & " ','" & rs("TestCost") & "', -1   )")
          
            strtnid = rs!TestName

Call SaveTestPro(strtnid, strtoid)
 
 rs.MoveNext
 Loop While Not rs.EOF
 End With
 DoCmd.SetWarnings True
End Sub
 
You must log in or register to reply here.

Similar threads

D
Loop stuck at the first record when execution of module ends...
Replies
2
Views
465
dkc123
D

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom