Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How To Query On Non-Existent Records

How To

How To Query On Non-Existent Records

by  JoyInOK  Posted    (Edited  )
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
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top