Message Box to Display a count of Records

M

Michael

I have the following code triggered by a button click on a form. The code is
designed to search in a table and only retrieve the specific record or
records. What I am interested in doing is that right after that click, the
user will be visually notified of the number of total records found according
to the criteria entered to be retrieved. Preferably a message saying
something like, '5 accounts found'. Thanks!

---------------------------------------------------------------------
Option Compare Database

Private Sub Command19_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control

'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
End Select
Next

'Remove the form's filter.
Me.FilterOn = False

End Sub

Private Sub Command104_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control

'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
Case acCheckBox
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
ctl.value = False
End Select
Next

'Remove the form's filter.
Me.FilterOn = False
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
If Not IsNull(Me.txtFilteraccount) Then
Me.txtFilteraccount = Null
End If
If Not IsNull(Me.txtFiltercust) Then
Me.txtFiltercust = Null
End If
If Not IsNull(Me.txtFilterstnum) Then
Me.txtFilterstnum = Null
End If
If Not IsNull(Me.txtFilterstname) Then
Me.txtFilterstname = Null
End If
If Not IsNull(Me.txtFiltercity) Then
Me.txtFiltercity = Null

End If
End Sub

Private Sub Command9_Click()
'Purpose: Build up the criteria string form the non-blank search boxes,
and apply to the form's Filter.
'Notes: 1. We tack " AND " on the end of each condition so you can
easily add more search boxes; _
we remove the trailing " AND " at the end.
' 2. The date range works like this: _
Both dates = only dates between (both
inclusive. _
Start date only = all dates from this one onwards; _
End date only = all dates up to (and including
this one).
Dim strWhere As String 'The criteria string.
Dim lngLen As Long 'Length of the criteria string
to append to.
Const conJetDate = "\#mm\/dd\/yyyy\#" 'The format expected for dates
in a JET query string.

If Not IsNull(Me.txtFiltercorp) Then
strWhere = strWhere & "([Corp] Like ""*" & Me.txtFiltercorp & "*"")
AND "
End If

If Not IsNull(Me.txtFilteraccount) Then
strWhere = strWhere & "([Account] Like ""*" & Me.txtFilteraccount &
"*"") AND "
End If

If Not IsNull(Me.txtFiltercust) Then
strWhere = strWhere & "([Customer] Like ""*" & Me.txtFiltercust &
"*"") AND "
End If

If Not IsNull(Me.txtFilterstnum) Then
strWhere = strWhere & "([StreetNum] Like ""*" & Me.txtFilterstnum &
"*"") AND "
End If

If Not IsNull(Me.txtFilterstname) Then
strWhere = strWhere & "([StreetName] Like ""*" & Me.txtFilterstname
& "*"") AND "
End If
If Not IsNull(Me.txtFiltercity) Then
strWhere = strWhere & "([City] Like ""*" & Me.txtFiltercity & "*"")
AND "
End If
'***********************************************************************
'Chop off the trailing " AND ", and use the string as the form's Filter.
'***********************************************************************
'See if the string has more than 5 characters (a trailng " AND ") to
remove.
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove the "
AND " at the end.
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line. Prints to
Immediate Window (Ctrl+G).
'Debug.Print strWhere

'Finally, apply the string as the form's Filter.
Me.Filter = strWhere
Me.FilterOn = True
End If

End Sub


Private Sub Form_BeforeInsert(Cancel As Integer)
'To avoid problems if the filter returns no records, we did not set its
AllowAdditions to No.
'We prevent new records by cancelling the form's BeforeInsert event
instead.
'The problems are explained at http://allenbrowne.com/bug-06.html
Cancel = True
MsgBox "You cannot add new clients to the search form.", vbInformation,
"Permission denied."

End Sub

Private Sub Form_Open(Cancel As Integer)
'Remove the single quote from these lines if you want to initially show
no records.
Me.Filter = "(False)"
Me.FilterOn = True

End Sub
Private Sub Command22_Click()
On Error GoTo Err_Command22_Click


DoCmd.PrintOut

Exit_Command22_Click:
Exit Sub

Err_Command22_Click:
MsgBox Err.Description
Resume Exit_Command22_Click

End Sub
Private Sub Command25_Click()
On Error GoTo Err_Command25_Click


DoCmd.Close

Exit_Command25_Click:
Exit Sub

Err_Command25_Click:
MsgBox Err.Description
Resume Exit_Command25_Click

End Sub
Private Sub Command29_Click()
On Error GoTo Err_Command29_Click


DoCmd.DoMenuItem acFormBar, acRecordsMenu, 2, , acMenuVer70

Exit_Command29_Click:
Exit Sub

Err_Command29_Click:
MsgBox Err.Description
Resume Exit_Command29_Click

End Sub


Private Sub Command44_Click()
On Error GoTo Err_Command44_Click


DoCmd.GoToRecord , , acNewRec

Exit_Command44_Click:
Exit Sub

Err_Command44_Click:
MsgBox Err.Description
Resume Exit_Command44_Click

End Sub
Private Sub Command47_Click()
On Error GoTo Err_Command47_Click

Dim stDocName As String

stDocName = "Query1"
DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_Command47_Click:
Exit Sub

Err_Command47_Click:
MsgBox Err.Description
Resume Exit_Command47_Click

End Sub
Private Sub Command86_Click()
On Error GoTo Err_Command86_Click


DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Exit_Command86_Click:
Exit Sub

Err_Command86_Click:
MsgBox Err.Description
Resume Exit_Command86_Click

End Sub
----------------------------------------------------------------------------
 
D

Douglas J. Steele

Right after

Me.Filter = strWhere
Me.FilterOn = True

Put

MsgBox Me.RecordsetClone.RecordCount & " accounts found."


--
Doug Steele, Microsoft Access MVP
http://www.AccessMVP.com/DJSteele
(no e-mails, please!)

Michael said:
I have the following code triggered by a button click on a form. The code
is
designed to search in a table and only retrieve the specific record or
records. What I am interested in doing is that right after that click,
the
user will be visually notified of the number of total records found
according
to the criteria entered to be retrieved. Preferably a message saying
something like, '5 accounts found'. Thanks!

---------------------------------------------------------------------
Option Compare Database

Private Sub Command19_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control

'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
End Select
Next

'Remove the form's filter.
Me.FilterOn = False

End Sub

Private Sub Command104_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control

'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
Case acCheckBox
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
ctl.value = False
End Select
Next

'Remove the form's filter.
Me.FilterOn = False
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
If Not IsNull(Me.txtFilteraccount) Then
Me.txtFilteraccount = Null
End If
If Not IsNull(Me.txtFiltercust) Then
Me.txtFiltercust = Null
End If
If Not IsNull(Me.txtFilterstnum) Then
Me.txtFilterstnum = Null
End If
If Not IsNull(Me.txtFilterstname) Then
Me.txtFilterstname = Null
End If
If Not IsNull(Me.txtFiltercity) Then
Me.txtFiltercity = Null

End If
End Sub

Private Sub Command9_Click()
'Purpose: Build up the criteria string form the non-blank search boxes,
and apply to the form's Filter.
'Notes: 1. We tack " AND " on the end of each condition so you can
easily add more search boxes; _
we remove the trailing " AND " at the end.
' 2. The date range works like this: _
Both dates = only dates between (both
inclusive. _
Start date only = all dates from this one onwards;
_
End date only = all dates up to (and including
this one).
Dim strWhere As String 'The criteria string.
Dim lngLen As Long 'Length of the criteria string
to append to.
Const conJetDate = "\#mm\/dd\/yyyy\#" 'The format expected for dates
in a JET query string.

If Not IsNull(Me.txtFiltercorp) Then
strWhere = strWhere & "([Corp] Like ""*" & Me.txtFiltercorp & "*"")
AND "
End If

If Not IsNull(Me.txtFilteraccount) Then
strWhere = strWhere & "([Account] Like ""*" & Me.txtFilteraccount &
"*"") AND "
End If

If Not IsNull(Me.txtFiltercust) Then
strWhere = strWhere & "([Customer] Like ""*" & Me.txtFiltercust &
"*"") AND "
End If

If Not IsNull(Me.txtFilterstnum) Then
strWhere = strWhere & "([StreetNum] Like ""*" & Me.txtFilterstnum &
"*"") AND "
End If

If Not IsNull(Me.txtFilterstname) Then
strWhere = strWhere & "([StreetName] Like ""*" & Me.txtFilterstname
& "*"") AND "
End If
If Not IsNull(Me.txtFiltercity) Then
strWhere = strWhere & "([City] Like ""*" & Me.txtFiltercity & "*"")
AND "
End If

'***********************************************************************
'Chop off the trailing " AND ", and use the string as the form's
Filter.

'***********************************************************************
'See if the string has more than 5 characters (a trailng " AND ") to
remove.
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove the "
AND " at the end.
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line. Prints
to
Immediate Window (Ctrl+G).
'Debug.Print strWhere

'Finally, apply the string as the form's Filter.
Me.Filter = strWhere
Me.FilterOn = True
End If

End Sub


Private Sub Form_BeforeInsert(Cancel As Integer)
'To avoid problems if the filter returns no records, we did not set its
AllowAdditions to No.
'We prevent new records by cancelling the form's BeforeInsert event
instead.
'The problems are explained at http://allenbrowne.com/bug-06.html
Cancel = True
MsgBox "You cannot add new clients to the search form.", vbInformation,
"Permission denied."

End Sub

Private Sub Form_Open(Cancel As Integer)
'Remove the single quote from these lines if you want to initially show
no records.
Me.Filter = "(False)"
Me.FilterOn = True

End Sub
Private Sub Command22_Click()
On Error GoTo Err_Command22_Click


DoCmd.PrintOut

Exit_Command22_Click:
Exit Sub

Err_Command22_Click:
MsgBox Err.Description
Resume Exit_Command22_Click

End Sub
Private Sub Command25_Click()
On Error GoTo Err_Command25_Click


DoCmd.Close

Exit_Command25_Click:
Exit Sub

Err_Command25_Click:
MsgBox Err.Description
Resume Exit_Command25_Click

End Sub
Private Sub Command29_Click()
On Error GoTo Err_Command29_Click


DoCmd.DoMenuItem acFormBar, acRecordsMenu, 2, , acMenuVer70

Exit_Command29_Click:
Exit Sub

Err_Command29_Click:
MsgBox Err.Description
Resume Exit_Command29_Click

End Sub


Private Sub Command44_Click()
On Error GoTo Err_Command44_Click


DoCmd.GoToRecord , , acNewRec

Exit_Command44_Click:
Exit Sub

Err_Command44_Click:
MsgBox Err.Description
Resume Exit_Command44_Click

End Sub
Private Sub Command47_Click()
On Error GoTo Err_Command47_Click

Dim stDocName As String

stDocName = "Query1"
DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_Command47_Click:
Exit Sub

Err_Command47_Click:
MsgBox Err.Description
Resume Exit_Command47_Click

End Sub
Private Sub Command86_Click()
On Error GoTo Err_Command86_Click


DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Exit_Command86_Click:
Exit Sub

Err_Command86_Click:
MsgBox Err.Description
Resume Exit_Command86_Click

End Sub
Click to expand...
 
R

ryguy7272

nRecords = DCount("*", "Query1") 'generic solution
'or in your case I think you can use this:
'nRecords = DCount("*", "stDocName")
If nRecords = 0 Then
MsgBox "zero records.", vbInformation, "System Error"
End If
 
M

Michael

Douglas,

You are the man!! Thank you so much, worked beautifully!

Douglas J. Steele said:
Right after

Me.Filter = strWhere
Me.FilterOn = True

Put

MsgBox Me.RecordsetClone.RecordCount & " accounts found."


--
Doug Steele, Microsoft Access MVP
http://www.AccessMVP.com/DJSteele
(no e-mails, please!)

Michael said:
I have the following code triggered by a button click on a form. The code
is
designed to search in a table and only retrieve the specific record or
records. What I am interested in doing is that right after that click,
the
user will be visually notified of the number of total records found
according
to the criteria entered to be retrieved. Preferably a message saying
something like, '5 accounts found'. Thanks!

---------------------------------------------------------------------
Option Compare Database

Private Sub Command19_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control

'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
End Select
Next

'Remove the form's filter.
Me.FilterOn = False

End Sub

Private Sub Command104_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control

'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
Case acCheckBox
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
ctl.value = False
End Select
Next

'Remove the form's filter.
Me.FilterOn = False
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
If Not IsNull(Me.txtFilteraccount) Then
Me.txtFilteraccount = Null
End If
If Not IsNull(Me.txtFiltercust) Then
Me.txtFiltercust = Null
End If
If Not IsNull(Me.txtFilterstnum) Then
Me.txtFilterstnum = Null
End If
If Not IsNull(Me.txtFilterstname) Then
Me.txtFilterstname = Null
End If
If Not IsNull(Me.txtFiltercity) Then
Me.txtFiltercity = Null

End If
End Sub

Private Sub Command9_Click()
'Purpose: Build up the criteria string form the non-blank search boxes,
and apply to the form's Filter.
'Notes: 1. We tack " AND " on the end of each condition so you can
easily add more search boxes; _
we remove the trailing " AND " at the end.
' 2. The date range works like this: _
Both dates = only dates between (both
inclusive. _
Start date only = all dates from this one onwards;
_
End date only = all dates up to (and including
this one).
Dim strWhere As String 'The criteria string.
Dim lngLen As Long 'Length of the criteria string
to append to.
Const conJetDate = "\#mm\/dd\/yyyy\#" 'The format expected for dates
in a JET query string.

If Not IsNull(Me.txtFiltercorp) Then
strWhere = strWhere & "([Corp] Like ""*" & Me.txtFiltercorp & "*"")
AND "
End If

If Not IsNull(Me.txtFilteraccount) Then
strWhere = strWhere & "([Account] Like ""*" & Me.txtFilteraccount &
"*"") AND "
End If

If Not IsNull(Me.txtFiltercust) Then
strWhere = strWhere & "([Customer] Like ""*" & Me.txtFiltercust &
"*"") AND "
End If

If Not IsNull(Me.txtFilterstnum) Then
strWhere = strWhere & "([StreetNum] Like ""*" & Me.txtFilterstnum &
"*"") AND "
End If

If Not IsNull(Me.txtFilterstname) Then
strWhere = strWhere & "([StreetName] Like ""*" & Me.txtFilterstname
& "*"") AND "
End If
If Not IsNull(Me.txtFiltercity) Then
strWhere = strWhere & "([City] Like ""*" & Me.txtFiltercity & "*"")
AND "
End If

'***********************************************************************
'Chop off the trailing " AND ", and use the string as the form's
Filter.

'***********************************************************************
'See if the string has more than 5 characters (a trailng " AND ") to
remove.
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove the "
AND " at the end.
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line. Prints
to
Immediate Window (Ctrl+G).
'Debug.Print strWhere

'Finally, apply the string as the form's Filter.
Me.Filter = strWhere
Me.FilterOn = True
End If

End Sub


Private Sub Form_BeforeInsert(Cancel As Integer)
'To avoid problems if the filter returns no records, we did not set its
AllowAdditions to No.
'We prevent new records by cancelling the form's BeforeInsert event
instead.
'The problems are explained at http://allenbrowne.com/bug-06.html
Cancel = True
MsgBox "You cannot add new clients to the search form.", vbInformation,
"Permission denied."

End Sub

Private Sub Form_Open(Cancel As Integer)
'Remove the single quote from these lines if you want to initially show
no records.
Me.Filter = "(False)"
Me.FilterOn = True

End Sub
Private Sub Command22_Click()
On Error GoTo Err_Command22_Click


DoCmd.PrintOut

Exit_Command22_Click:
Exit Sub

Err_Command22_Click:
MsgBox Err.Description
Resume Exit_Command22_Click

End Sub
Private Sub Command25_Click()
On Error GoTo Err_Command25_Click


DoCmd.Close

Exit_Command25_Click:
Exit Sub

Err_Command25_Click:
MsgBox Err.Description
Resume Exit_Command25_Click

End Sub
Private Sub Command29_Click()
On Error GoTo Err_Command29_Click


DoCmd.DoMenuItem acFormBar, acRecordsMenu, 2, , acMenuVer70

Exit_Command29_Click:
Exit Sub

Err_Command29_Click:
MsgBox Err.Description
Resume Exit_Command29_Click

End Sub


Private Sub Command44_Click()
On Error GoTo Err_Command44_Click


DoCmd.GoToRecord , , acNewRec

Exit_Command44_Click:
Exit Sub

Err_Command44_Click:
MsgBox Err.Description
Resume Exit_Command44_Click

End Sub
Private Sub Command47_Click()
On Error GoTo Err_Command47_Click

Dim stDocName As String

stDocName = "Query1"
DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_Command47_Click:
Exit Sub

Err_Command47_Click:
MsgBox Err.Description
Resume Exit_Command47_Click

End Sub
Private Sub Command86_Click()
On Error GoTo Err_Command86_Click


DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Exit_Command86_Click:
Exit Sub

Err_Command86_Click:
MsgBox Err.Description
Resume Exit_Command86_Click

End Sub
Click to expand...


.
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Working outlook via vba code with xlsx - error 0
Making a macro only work on certain files 2
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
Filter Text Syntax 2
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
CODE HELP! 2
Cleanup Code on Form ?? 4
Filtering a multiple item form 1

Top