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()
[color blue]'create a list of subgrantees who have not returned their request for funds by the due date [/color]
Dim rstAllSubs As DAO.Recordset
Dim strSQL As String
Dim strRDate As String
[color blue]'check that the date entered is valid[/color]
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
[color blue]'create recordset of all active subgrantee numbers[/color]
strSQL = "SELECT SubNo1, Name, Active FROM GEN_ED_T WHERE Active = 'Y';"
Set rstAllSubs = CurrentDb.OpenRecordset(strSQL)
If rstAllSubs.RecordCount = 0 Then [color blue]'there are no payments issued[/color]
MsgBox "There are no subgrantees with the Active field checked Y'.", vbOKOnly, "No Active Subgrantees"
Set rstAllSubs = Nothing
Exit Sub
End If
[color blue]'move to the last record to get an accurate record count[/color]
rstAllSubs.MoveLast
rstAllSubs.MoveFirst
[color blue]'create recordset of all subgrantees who have returned their request for the given date[/color]
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 [color red]'no subgrantees have returned the request[/color]
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
[color blue]'compare the recordsets to create a list of those who have not returned their request[/color]
Dim intAllSubs As Integer
Dim intGotIt As Integer
Dim rstSlackers As Recordset
Set rstSlackers = CurrentDb.OpenRecordset("tblSlackers")
[color blue]'clear the old slackers from the table[/color]
Dim i As Integer
For i = 1 To rstSlackers.RecordCount
rstSlackers.Delete
rstSlackers.MoveNext
Next i
For intAllSubs = 1 To rstAllSubs.RecordCount
[color blue]'if the subgrantee number is not found in the gotit recordset, place[/color]
[color blue]'the subgrantee number in a table used as the list box's row source[/color]
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
[color blue]'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[/color]
Set rstAllSubs = Nothing
Set rstSlackers = Nothing
Set rstAllSubs = Nothing
[color blue]'requery the combo box to reflect the new slackers[/color]
cboSlackers.Requery
cboSlackers.ListIndex = -1
End Sub
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.