Question : VBA code to loop through two different record sets and output message boxes

I have attached my database and need help with the following:

The user enters a part number and a supplier name. After the user UPDATES the supplier name field, I would like a vba code to run which performs the following:
1. The code selects the left 7 characters of the part number entered by the user in the form
2. The code then opens the query "iitdts" as a recordset
3. The code then matches the left 7 characters of the part number AND the supplier name entered in the form against the recordset. If a part and supplier name match is found, a message box is prompted "Part and Supplier Match". After the user clicks the OK button from the message box, the "iitdts" recordset closes, and the code opens the query "iitdts77" as a recordset.
3a. The code then performs the same operation with this iitdts77 recordset. If a part and supplier match are found, a
message box is displayed "7th Lot Inspection Required", Else a message box is displayed "No Inspection Required."
Close iitdts77 and Exit Sub (While the code is running and the user is waiting, it would be nice to see a
display stating "Checking......Please Wait")

4. Back to the iitdts recordset.......If only a part match is found but not a supplier name, a message box is prompted "Part Match Only - Inspection Required". If no part match is found (regardless of the supplier name), a message box is prompted "No Part Match - Inspection Required".
Close iitdts and Exit Sub

Answer : VBA code to loop through two different record sets and output message boxes

Hi Sanjay

The code below will achieve what you want.

However, it will run VERY slowly, not because of the code, but because of the design of your queries. Perhaps you should redesign the queries to perform the checks more efficiently. But that is certainly beyong the scope of this question.

--
Graham

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:

           
           
             Private Sub Supplier_Name_AfterUpdate()

On Error GoTo ErrorHandler
Dim DB As DAO.Database
Dim rst As DAO.Recordset

  Set DB = CurrentDb
  
  DoCmd.Hourglass True
  SysCmd acSysCmdSetStatus, "Checking......Please Wait"
  
  Set rst = DB.OpenRecordset("Select * from iitdts where Part='" & Left(Me.Part, 7) & "'")
  
  With rst
    If .EOF Then
      MsgBox "No Part Match - Inspection Required"
      GoTo ExitProc
    End If
    .FindFirst "SupplierName=""" & Me.Supplier_Name & """"
    If .NoMatch Then
      MsgBox "Part Match Only - Inspection Required"
      GoTo ExitProc
    End If
    .Close
  End With
  
  Set rst = DB.OpenRecordset("Select * from iitdts77 where Part='" & Left(Me.Part, 7) _
    & "' and SupplierName=""" & Me.Supplier_Name & """")
  
  With rst
    If .EOF Then
      MsgBox "No Inspection Required"
    Else
      MsgBox "7th Lot Inspection Required"
    End If
    .Close
  End With
  
ExitProc:
  On Error Resume Next
  If Not rst Is Nothing Then
    rst.Close
    Set rst = Nothing
  End If
  DoCmd.Hourglass False
  SysCmd acSysCmdClearStatus

Exit Sub

ErrorHandler:
  MsgBox "Error #" & Err & vbCrLf & Err.Description
  Resume ExitProc
  
End Sub

           
         

Open in New Window

Select All