Display the number of results of a query

A

Absolute_Beginner

Registered User.
Local time
Today, 21:59
Joined
Aug 3, 2011
Messages
10
Hello everybody,

I have a search form, which works with the following code (wasn't written by me). If the search was successful, a new form pops up displaying the matching data.

Code: 
Private Sub Befehl33_Click() 
'Suche starten 


    Dim rst As DAO.Recordset 
    Dim ctl As Control 
    Dim strCriteria As String 
    Dim strCriteria2 As String 
    Dim strCriteria3 As String 
    Dim strSQL As String 
    Dim strINList_Sitzung As String 
    Dim strINList_themen As String 
    
    strCriteria = "1 = 1" 
    For Each ctl In Me.Controls 
        If ctl.Tag <> "" Then 
            If Nz(ctl.Value, "") <> "" Then 
                Select Case ctl.Tag 
                    Case "Aufgabe", "Beauftragter" 
                        strCriteria = strCriteria & " AND [" & ctl.Tag & "] Like '*" & ctl.Value & "*'" 
                    Case "Datum_1" 
                        If IsDate(ctl.Value) Then strCriteria = strCriteria & " AND [Datum] >= " & Format(ctl.Value, "\#yyyy\-mm\-dd\#") 
                    Case "Datum_2" 
                        If IsDate(ctl.Value) Then strCriteria = strCriteria & " AND [Datum] <= " & Format(ctl.Value, "\#yyyy\-mm\-dd\#") 
                    Case "Erledigt" 
                        If ctl.Value = 1 Then 
                            strCriteria = strCriteria & " AND [" & ctl.Tag & "] = True" 
                        ElseIf ctl.Value = 2 Then 
                            strCriteria = strCriteria & " AND [" & ctl.Tag & "] = False" 
                        End If 
                    Case Else 
                End Select 
            End If 
        End If 
    Next ctl 
    
    strCriteria2 = strCriteria 

    strCriteria = "WHERE " & strCriteria 
    
   strSQL = "SELECT DISTINCT tblThemen.themen_id, tblThemen.sitzung_id_f AS sitzung_id " & _ 
             "FROM tblThemen INNER JOIN tblAufgabe ON tblThemen.themen_id = tblAufgabe.themen_ID_f " & _ 
             strCriteria & ";" 
    
    Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot) 
    With rst 
        Do Until .EOF 
            If Len(strINList_Sitzung) > 0 Then strINList_Sitzung = strINList_Sitzung & "," 
            strINList_Sitzung = strINList_Sitzung & !sitzung_id 
            If Len(strINList_themen) > 0 Then strINList_themen = strINList_themen & "," 
            strINList_themen = strINList_themen & !themen_id 
            .MoveNext 
        Loop 
        .Close 
    End With 
    Set rst = Nothing 
    
    If Len(strINList_Sitzung) > 0 Then 
    
        strCriteria = "sitzung_id IN ( " & strINList_Sitzung & " )" 
        
        DoCmd.OpenForm "frmSitzung3", , , strCriteria 
        
        DoEvents 
        
        Forms("frmSitzung3").ufoAufgaben2.Form.Filter = strCriteria2 
        
        strCriteria3 = "themen_id IN ( " & strINList_themen & " )" 
        Forms("frmSitzung3").ufoThemen2.Form.Filter = strCriteria3 
        Forms!frmSitzung3.AllowEdits = False 
        Forms!frmSitzung3!ufoThemen2.Form.AllowEdits = False 
        Forms!frmSitzung3!ufoAufgaben2.Form.AllowEdits = False 
        

    
    Else 
    
        MsgBox "No records were found matching the specified criteria.", vbInformation, "Mo match" 
    End If


I would now like a message box to pop up, displaying the number of results found.

How can I accomplish that? Thank you for your help!
 
You're already looping through the recordset:
Code: 
With rst 
        Do Until .EOF 
            If Len(strINList_Sitzung) > 0 Then strINList_Sitzung = strINList_Sitzung & "," 
            strINList_Sitzung = strINList_Sitzung & !sitzung_id 
            If Len(strINList_themen) > 0 Then strINList_themen = strINList_themen & "," 
            strINList_themen = strINList_themen & !themen_id 
            .MoveNext 
        Loop 
        .Close 
    End With

You could simply add an integer set to increase by 1 within the loop:

Code: 
Dim intRstCounter as Integer
intRstCounter = 0
With rst 
        Do Until .EOF 
            intRstCounter = intRstCounter + 1
            If Len(strINList_Sitzung) > 0 Then strINList_Sitzung = strINList_Sitzung & "," 
            strINList_Sitzung = strINList_Sitzung & !sitzung_id 
            If Len(strINList_themen) > 0 Then strINList_themen = strINList_themen & "," 
            strINList_themen = strINList_themen & !themen_id 
            .MoveNext 
        Loop 
        .Close 
    End With 
    MsgBox intRstCounter & " records found."

I'm sure there's a .recordcount property for the recordet too, just be sure to .movelast first (and .movefirst after if you do it before the rest of the code using the recordset) to ensure it has an accurate record count.
 
Thank you for your quick reply!

Unfortunately, there is some sort of error. I'm not sure if I could translate the error message correctly, so I'll upload a sample database.

The code I posted belongs to the "go" button of the search form that opens up when you click on "task search" in the form that automatically opens up when you load the database.
 

Attachments

You are trying to loop through & count the recordset before you have even defined it.

You have duplicated the loop through the rst at the beginning of the code, however it cannot be done until rst has been set and strSQL has been concatonated from the controls.

Instead of having a duplicate loop at the beginning (which will not work), add the intRstCounter code to the existing loop further down in the code.
 
Thank you for your help! I'm sorry, I've got absolutely no knowledge of VBA code. The existing code was written by someone else. Please bear with me.

So, here's what I've done:

Code: 
Private Sub Befehl33_Click()
'Suche starten
 
    Dim rst As DAO.Recordset
    Dim ctl As Control
    Dim strCriteria As String
    Dim strCriteria2 As String
    Dim strCriteria3 As String
    Dim strSQL As String
    Dim strINList_Sitzung As String
    Dim strINList_themen As String
   [COLOR=red]Dim intRstCounter As Integer[/COLOR]
[COLOR=red]   intRstCounter = 0[/COLOR]
 
    strCriteria = "1 = 1"
    For Each ctl In Me.Controls
        If ctl.Tag <> "" Then
            If Nz(ctl.Value, "") <> "" Then
                Select Case ctl.Tag
                    Case "Aufgabe", "Beauftragter"
                        strCriteria = strCriteria & " AND [" & ctl.Tag & "] Like '*" & ctl.Value & "*'"
                    Case "Datum_1"
                        If IsDate(ctl.Value) Then strCriteria = strCriteria & " AND [Datum] >= " & Format(ctl.Value, "\#yyyy\-mm\-dd\#")
                    Case "Datum_2"
                        If IsDate(ctl.Value) Then strCriteria = strCriteria & " AND [Datum] <= " & Format(ctl.Value, "\#yyyy\-mm\-dd\#")
                    Case "Erledigt"
                        If ctl.Value = 1 Then
                            strCriteria = strCriteria & " AND [" & ctl.Tag & "] = True"
                        ElseIf ctl.Value = 2 Then
                            strCriteria = strCriteria & " AND [" & ctl.Tag & "] = False"
                        End If
                    Case Else
                End Select
            End If
        End If
    Next ctl
 
    strCriteria2 = strCriteria
    strCriteria = "WHERE " & strCriteria
 
   strSQL = "SELECT DISTINCT tblThemen.themen_id, tblThemen.sitzung_id_f AS sitzung_id " & _
             "FROM tblThemen INNER JOIN tblAufgabe ON tblThemen.themen_id = tblAufgabe.themen_ID_f " & _
             strCriteria & ";"
 
    Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
    With rst
        Do Until .EOF
            If Len(strINList_Sitzung) > 0 Then strINList_Sitzung = strINList_Sitzung & ","
            strINList_Sitzung = strINList_Sitzung & !sitzung_id
            If Len(strINList_themen) > 0 Then strINList_themen = strINList_themen & ","
            strINList_themen = strINList_themen & !themen_id
            [COLOR=red]With rst[/COLOR]
[COLOR=red]       Do Until .EOF[/COLOR]
[COLOR=red]           intRstCounter = intRstCounter + 1[/COLOR]
[COLOR=red]           If Len(strINList_Sitzung) > 0 Then strINList_Sitzung = strINList_Sitzung & ","[/COLOR]
[COLOR=red]           strINList_Sitzung = strINList_Sitzung & !sitzung_id[/COLOR]
[COLOR=red]           If Len(strINList_themen) > 0 Then strINList_themen = strINList_themen & ","[/COLOR]
[COLOR=red]           strINList_themen = strINList_themen & !themen_id[/COLOR]
[COLOR=red]           .[/COLOR][COLOR=red]MoveNext[/COLOR]
[COLOR=red]       Loop[/COLOR]
[COLOR=red]       .Close[/COLOR]
[COLOR=red]   End With[/COLOR]
[COLOR=red]   MsgBox intRstCounter & " records found."[/COLOR]
[COLOR=red]           .MoveNext[/COLOR]
        Loop
        .Close
    End With
    Set rst = Nothing
 
    If Len(strINList_Sitzung) > 0 Then
 
        strCriteria = "sitzung_id IN ( " & strINList_Sitzung & " )"
 
        DoCmd.OpenForm "frmSitzung2", , , strCriteria
 
        DoEvents
 
        Forms("frmSitzung2").ufoAufgaben2.Form.Filter = strCriteria2
 
        strCriteria3 = "themen_id IN ( " & strINList_themen & " )"
        Forms("frmSitzung2").ufoThemen2.Form.Filter = strCriteria3
        Forms!frmSitzung2.AllowEdits = False
        Forms!frmSitzung2!ufoThemen2.Form.AllowEdits = False
        Forms!frmSitzung2!ufoAufgaben2.Form.AllowEdits = False
 
 
    Else
 
        MsgBox "No records were found matching the specified criteria.", vbInformation, "Mo match"
    End If
End Sub

A message box displaying the number of results does pop up, but then the debugger highlights this line:

Code: 
 MsgBox intRstCounter & " records found."
            [COLOR=red].MoveNext[/COLOR]
        Loop


I realize that it's probaby a very stupid mistake, but as I don't really know what I am doing, operating on a trial and error basis is the best I can do.

Could you please put me out of my misery and tell me what the error is? :) Thank you so much!
 
Try this (untested):
Code: 
[COLOR=black]Private Sub Befehl33_Click()[/COLOR]
[COLOR=black]'Suche starten[/COLOR]
 
[COLOR=black]  Dim rst As DAO.Recordset[/COLOR]
[COLOR=black]  Dim ctl As Control[/COLOR]
[COLOR=black]  Dim strCriteria As String[/COLOR]
[COLOR=black]  Dim strCriteria2 As String[/COLOR]
[COLOR=black]  Dim strCriteria3 As String[/COLOR]
[COLOR=black]  Dim strSQL As String[/COLOR]
[COLOR=black]  Dim strINList_Sitzung As String[/COLOR]
[COLOR=black]  Dim strINList_themen As String[/COLOR]
[COLOR=black]  Dim intRstCounter As Integer[/COLOR]
[COLOR=black]  intRstCounter = 0[/COLOR]
 
[COLOR=black]  strCriteria = "1 = 1"[/COLOR]
[COLOR=black]  For Each ctl In Me.Controls[/COLOR]
[COLOR=black]      If ctl.Tag <> "" Then[/COLOR]
[COLOR=black]          If Nz(ctl.Value, "") <> "" Then[/COLOR]
[COLOR=black]              Select Case ctl.Tag[/COLOR]
[COLOR=black]                  Case "Aufgabe", "Beauftragter"[/COLOR]
[COLOR=black]                      strCriteria = strCriteria & " AND [" & ctl.Tag & "] Like '*" & ctl.Value & "*'"[/COLOR]
[COLOR=black]                  Case "Datum_1"[/COLOR]
[COLOR=black]                      If IsDate(ctl.Value) Then strCriteria = strCriteria & " AND [Datum] >= " & Format(ctl.Value, "\#yyyy\-mm\-dd\#")[/COLOR]
[COLOR=black]                  Case "Datum_2"[/COLOR]
[COLOR=black]                      If IsDate(ctl.Value) Then strCriteria = strCriteria & " AND [Datum] <= " & Format(ctl.Value, "\#yyyy\-mm\-dd\#")[/COLOR]
[COLOR=black]                  Case "Erledigt"[/COLOR]
[COLOR=black]                      If ctl.Value = 1 Then[/COLOR]
[COLOR=black]                          strCriteria = strCriteria & " AND [" & ctl.Tag & "] = True"[/COLOR]
[COLOR=black]                      ElseIf ctl.Value = 2 Then[/COLOR]
[COLOR=black]                          strCriteria = strCriteria & " AND [" & ctl.Tag & "] = False"[/COLOR]
[COLOR=black]                      End If[/COLOR]
[COLOR=black]                  Case Else[/COLOR]
[COLOR=black]              End Select[/COLOR]
[COLOR=black]          End If[/COLOR]
[COLOR=black]      End If[/COLOR]
[COLOR=black]  Next ctl[/COLOR]
 
[COLOR=black]  strCriteria2 = strCriteria[/COLOR]
[COLOR=black]  strCriteria = "WHERE " & strCriteria[/COLOR]
 
[COLOR=black] strSQL = "SELECT DISTINCT tblThemen.themen_id, tblThemen.sitzung_id_f AS sitzung_id " & _[/COLOR]
[COLOR=black]           "FROM tblThemen INNER JOIN tblAufgabe ON tblThemen.themen_id = tblAufgabe.themen_ID_f " & _[/COLOR]
[COLOR=black]           strCriteria & ";"[/COLOR]
 
[COLOR=black]  Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)[/COLOR]
[COLOR=black]  With rst[/COLOR]
[COLOR=black]      Do Until .EOF[/COLOR]
[COLOR=black]          If Len(strINList_Sitzung) > 0 Then strINList_Sitzung = strINList_Sitzung & ","[/COLOR]
[COLOR=black]          strINList_Sitzung = strINList_Sitzung & !sitzung_id[/COLOR]
[COLOR=black]          If Len(strINList_themen) > 0 Then strINList_themen = strINList_themen & ","[/COLOR]
[COLOR=black]          strINList_themen = strINList_themen & !themen_id[/COLOR]
[COLOR=black]          intRstCounter = intRstCounter + 1[/COLOR]
[COLOR=black].MoveNext[/COLOR]
[COLOR=black]      Loop[/COLOR]
[COLOR=black]      .Close[/COLOR]
[COLOR=black]  End With[/COLOR]
[COLOR=black]  Set rst = Nothing[/COLOR]
[COLOR=black]  MsgBox intRstCounter & " records found, please click OK to continue."[/COLOR]
[COLOR=black]  If Len(strINList_Sitzung) > 0 Then[/COLOR]
 
[COLOR=black]      strCriteria = "sitzung_id IN ( " & strINList_Sitzung & " )"[/COLOR]
 
[COLOR=black]      DoCmd.OpenForm "frmSitzung2", , , strCriteria[/COLOR]
 
[COLOR=black]      DoEvents[/COLOR]
 
[COLOR=black]      Forms("frmSitzung2").ufoAufgaben2.Form.Filter = strCriteria2[/COLOR]
 
[COLOR=black]      strCriteria3 = "themen_id IN ( " & strINList_themen & " )"[/COLOR]
[COLOR=black]      Forms("frmSitzung2").ufoThemen2.Form.Filter = strCriteria3[/COLOR]
[COLOR=black]      Forms!frmSitzung2.AllowEdits = False[/COLOR]
[COLOR=black]      Forms!frmSitzung2!ufoThemen2.Form.AllowEdits = False[/COLOR]
[COLOR=black]      Forms!frmSitzung2!ufoAufgaben2.Form.AllowEdits = False[/COLOR]
 
 
[COLOR=black]  Else[/COLOR]
 
[COLOR=black]      MsgBox "No records were found matching the specified criteria.", vbInformation, "Mo match"[/COLOR]
[COLOR=black]  End If[/COLOR]
[COLOR=black]End Sub[/COLOR]
 
Thank you very much! There's no error message, and the message box opens as desired to display the results. Unfortunately, the count is not always correct. If there's only one match, it works, but apart from that the number displayed seems to be smaller than the actual number of matches.

I really appreciate your patience and help!
 
It should work, at least it should show the number of times the loop which goes to rst.EOF (end of file) is run.

Try this, it uses rst.RecordCount instead.
Code: 
[COLOR=black]Private Sub Befehl33_Click()[/COLOR]
[COLOR=black]'Suche starten[/COLOR]
 
[COLOR=black] Dim rst As DAO.Recordset[/COLOR]
[COLOR=black] Dim ctl As Control[/COLOR]
[COLOR=black] Dim strCriteria As String[/COLOR]
[COLOR=black] Dim strCriteria2 As String[/COLOR]
[COLOR=black] Dim strCriteria3 As String[/COLOR]
[COLOR=black] Dim strSQL As String[/COLOR]
[COLOR=black] Dim strINList_Sitzung As String[/COLOR]
[COLOR=black] Dim strINList_themen As String[/COLOR]
 
[COLOR=black] strCriteria = "1 = 1"[/COLOR]
[COLOR=black] For Each ctl In Me.Controls[/COLOR]
[COLOR=black]     If ctl.Tag <> "" Then[/COLOR]
[COLOR=black]         If Nz(ctl.Value, "") <> "" Then[/COLOR]
[COLOR=black]             Select Case ctl.Tag[/COLOR]
[COLOR=black]                 Case "Aufgabe", "Beauftragter"[/COLOR]
[COLOR=black]                     strCriteria = strCriteria & " AND [" & ctl.Tag & "] Like '*" & ctl.Value & "*'"[/COLOR]
[COLOR=black]                 Case "Datum_1"[/COLOR]
[COLOR=black]                     If IsDate(ctl.Value) Then strCriteria = strCriteria & " AND [Datum] >= " & Format(ctl.Value, "\#yyyy\-mm\-dd\#")[/COLOR]
[COLOR=black]                 Case "Datum_2"[/COLOR]
[COLOR=black]                     If IsDate(ctl.Value) Then strCriteria = strCriteria & " AND [Datum] <= " & Format(ctl.Value, "\#yyyy\-mm\-dd\#")[/COLOR]
[COLOR=black]                 Case "Erledigt"[/COLOR]
[COLOR=black]                     If ctl.Value = 1 Then[/COLOR]
[COLOR=black]                         strCriteria = strCriteria & " AND [" & ctl.Tag & "] = True"[/COLOR]
[COLOR=black]                     ElseIf ctl.Value = 2 Then[/COLOR]
[COLOR=black]                         strCriteria = strCriteria & " AND [" & ctl.Tag & "] = False"[/COLOR]
[COLOR=black]                     End If[/COLOR]
[COLOR=black]                 Case Else[/COLOR]
[COLOR=black]             End Select[/COLOR]
[COLOR=black]         End If[/COLOR]
[COLOR=black]     End If[/COLOR]
[COLOR=black] Next ctl[/COLOR]
 
[COLOR=black] strCriteria2 = strCriteria[/COLOR]
[COLOR=black] strCriteria = "WHERE " & strCriteria[/COLOR]
 
[COLOR=black]strSQL = "SELECT DISTINCT tblThemen.themen_id, tblThemen.sitzung_id_f AS sitzung_id " & _[/COLOR]
[COLOR=black]          "FROM tblThemen INNER JOIN tblAufgabe ON tblThemen.themen_id = tblAufgabe.themen_ID_f " & _[/COLOR]
[COLOR=black]          strCriteria & ";"[/COLOR]
 
[COLOR=black] Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)[/COLOR]
[COLOR=black] With rst[/COLOR]
[COLOR=black]     Do Until .EOF[/COLOR]
[COLOR=black]         If Len(strINList_Sitzung) > 0 Then strINList_Sitzung = strINList_Sitzung & ","[/COLOR]
[COLOR=black]         strINList_Sitzung = strINList_Sitzung & !sitzung_id[/COLOR]
[COLOR=black]         If Len(strINList_themen) > 0 Then strINList_themen = strINList_themen & ","[/COLOR]
[COLOR=black]         strINList_themen = strINList_themen & !themen_id[/COLOR]
[COLOR=black].MoveNext[/COLOR]
[COLOR=black]     Loop[/COLOR]
     MsgBox .RecordCount & " records found, please click OK to continue."
[COLOR=black]     .Close[/COLOR]
[COLOR=black] End With[/COLOR]
[COLOR=black] Set rst = Nothing[/COLOR]
[COLOR=black] [/COLOR][COLOR=black]If Len(strINList_Sitzung) > 0 Then[/COLOR]
 
[COLOR=black]     strCriteria = "sitzung_id IN ( " & strINList_Sitzung & " )"[/COLOR]
 
[COLOR=black]     DoCmd.OpenForm "frmSitzung2", , , strCriteria[/COLOR]
 
[COLOR=black]     DoEvents[/COLOR]
 
[COLOR=black]     Forms("frmSitzung2").ufoAufgaben2.Form.Filter = strCriteria2[/COLOR]
 
[COLOR=black]     strCriteria3 = "themen_id IN ( " & strINList_themen & " )"[/COLOR]
[COLOR=black]     Forms("frmSitzung2").ufoThemen2.Form.Filter = strCriteria3[/COLOR]
[COLOR=black]     Forms!frmSitzung2.AllowEdits = False[/COLOR]
[COLOR=black]     Forms!frmSitzung2!ufoThemen2.Form.AllowEdits = False[/COLOR]
[COLOR=black]     Forms!frmSitzung2!ufoAufgaben2.Form.AllowEdits = False[/COLOR]
 
 
[COLOR=black] Else[/COLOR]
 
[COLOR=black]     MsgBox "No records were found matching the specified criteria.", vbInformation, "Mo match"[/COLOR]
[COLOR=black] End If[/COLOR]
[COLOR=black]End Sub[/COLOR]
 
I've just figured out that I had a wrong idea about which records were actually counted, I'm very sorry about that. The count does work perfectly fine, in both solutions.

Thank you very, very much for your help! It is very much appreciated!
 
You must log in or register to reply here.

Similar threads

M
Double click of listbox on a form
Replies
10
Views
617
moi
M
T
You can't hide a control that has the focus
Replies
9
Views
481
TheSearcher
T
S
Getting total in one line of the query
Replies
13
Views
393
silentwolf
S
zelarra821
Solved Protect VBA Project Programmatically with SendKeys
Replies
12
Views
903
zelarra821
zelarra821
C
Invalid use of Me.
Replies
8
Views
393
cheekybuddha
cheekybuddha

Users who are viewing this thread

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