If your database is structured so that no record is created if a client does not return a report in a given month, and you need a query to return a list of the "slackers" who didn't do the paperwork, this FAQ is for you. This code compares a list of all clients (subgrantees in this case) who should have returned a report with a list of the clients who did return the report, and populates a combo box with the clients who failed to report.
Note that this code uses DAO recordsets. Be sure you have a reference set to the DAO library.
Private Sub cmdCreateList_Click() 'create a list of subgrantees who have not returned their request for funds by the due date Dim rstAllSubs As DAO.Recordset Dim strSQL As String Dim strRDate As String 'check that the date entered is valid txtDueDate.SetFocus If Not IsDate(txtDueDate.Text) Then MsgBox "The date entered is not a valid date. Please try again.", vbOKOnly, "Invalid Date" Exit Sub Else strRDate = txtDueDate.Text End If 'create recordset of all active subgrantee numbers strSQL = "SELECT SubNo1, Name, Active FROM GEN_ED_T WHERE Active = 'Y';" Set rstAllSubs = CurrentDb.OpenRecordset(strSQL) If rstAllSubs.RecordCount = 0 Then 'there are no payments issued MsgBox "There are no subgrantees with the Active field checked Y''.", vbOKOnly, "No Active Subgrantees" Set rstAllSubs = Nothing Exit Sub End If 'move to the last record to get an accurate record count rstAllSubs.MoveLast rstAllSubs.MoveFirst
'create recordset of all subgrantees who have returned their request for the given date Dim rstGotIt As Recordset strSQL = "SELECT [REQ$_T].RDATE, [REQ$_T].SubNo2, GEN_ED_T.ACTIVE FROM GEN_ED_T INNER JOIN [REQ$_T] ON GEN_ED_T.SubNo1 = [REQ$_T].SubNo2 WHERE ((([REQ$_T].RDATE)=#" & strRDate & "#) AND ((GEN_ED_T.ACTIVE)='Y'));" Set rstGotIt = CurrentDb.OpenRecordset(strSQL) If rstGotIt.RecordCount = 0 Then 'no subgrantees have returned the request MsgBox "No subgrantees have returned a request for that date.", vbOKOnly, "No Requests For Given Date" Set rstGotIt = Nothing Set rstAllSubs = Nothing Exit Sub End If 'compare the recordsets to create a list of those who have not returned their request Dim intAllSubs As Integer Dim intGotIt As Integer Dim rstSlackers As Recordset Set rstSlackers = CurrentDb.OpenRecordset("tblSlackers") 'clear the old slackers from the table Dim i As Integer For i = 1 To rstSlackers.RecordCount rstSlackers.Delete rstSlackers.MoveNext Next i For intAllSubs = 1 To rstAllSubs.RecordCount
'if the subgrantee number is not found in the gotit recordset, place 'the subgrantee number in a table used as the list box's row source
With rstGotIt .MoveFirst .FindFirst "SubNo2= " & "'" & rstAllSubs.Fields("SubNo1") & "'" If .NoMatch Then rstSlackers.AddNew rstSlackers("SubgrantNo") = rstAllSubs.Fields("SubNo1") rstSlackers("SubgrantName") = rstAllSubs.Fields("Name") rstSlackers.Update End If
End With rstAllSubs.MoveNext Next intAllSubs Exit Sub
'list the slacker subgrantees in a table which will serve as the row source for a list box 'clicking the subgrantee's number in the list box will open an email to the subgrantee contact Set rstAllSubs = Nothing Set rstSlackers = Nothing Set rstAllSubs = Nothing 'requery the combo box to reflect the new slackers cboSlackers.Requery cboSlackers.ListIndex = -1 End Sub