Filter results in Microsoft Access 2010 Form using VBA - ms-access

I am working on an Access Database where I need to display records from a table in a form as a datasheet. I believe I have correctly written the code to perform the filtering, but am not sure how to display the records.
I know that I can perform this easier using a query, and then a form based on those results, but wish to limit this process if at all possible, to reduce the overall size of the database. The filter will be sorting a company, and the fiscal dates.
Any help is appreciated.
Here is the code I have thus far...
Option Compare Database
Sub Form_Current()
Dim oTable As DAO.Recordset
Dim oDataNeedsGas
Dim dNextFiscal, dThisFiscal
Dim iGas
'Fiscal Year turnover date, use DateValue(dNextFiscal) comparison.
dNextFiscal = "10/1/" & Year(Date)
dThisFiscal = "10/1/" & Year(Date) - 1
'For Annual training by year comparison.
'Year(DateValue(oTable!randomdate)) >= Year(Date)
Set oTable = Application.CurrentDb.OpenRecordset("tbl_main", dbOpenDynaset)
iGas = 0
Do Until oTable.EOF = True
If (Year(DateValue(oTable![GasDate])) >= Year(Date) And oTable![Platoon] = "Data") Then
`What do I do here?!!?
iGas = iGas + 1
End If
msgbox iGas
oTable.MoveNext
Loop
End Sub
I know the filtering works, because I have it count the matched records, then display in a message box, but I want to be able to display the matched records. How do I go about doing this?

Make the RecordSource on your Datasheet from blank and then have this code run when the form loads:
Option Compare Database
Private Sub Form_Load()
Dim sSQL as String
sSQL = "SELECT * FROM tbl_Main "
sSQL = sSQL & "WHERE Year(DateValue(GasDate)) >= Year(Date) "
sSQL = sSQL & " AND Platoon = 'Data'"
Me.RecordSource = sSQL
MsgBox "RecordCount: " & Me.RecordCount
End Sub
I generally use the Form's RecordSource and the Forms Filter and FilterOn properties. You can always load the form showing all records and then filter down to what you want to see.
I didn't understand this line in your question:
"...but wish to limit this process if at all possible, to reduce the overall size of the database."
Are you trying to increase performance? Are you worried about storing too much data and the tables getting too large? That part of your question just isn't clear.

You can set your Subform's Recordset property to oTable. Make the recordset a property of the main form though, as shown in the following code, so that you can release this reference when the form closes.
Option Compare Database
Private oTable As Object
Private Sub Command2_Click()
Set oTable = Application.CurrentDb.OpenRecordset("tbl_main", dbOpenDynaset)
Set Me.sbfName.Form.Recordset = oTable
End Sub
Private Sub Form_Close()
If Not oTable Is Nothing Then
Set oTable = Nothing
End If
End Sub
For your specific example you would OpenRecordset based on a SQL statement that includes your date-criteria. I haven't tested whether this will be updateable, as it is for a Table. (I am getting the impression that it will not be updateable.)
It is possible to do this but I'm not suggesting it is a recommended approach. It is far easier to use the RecordSource property, filtering its records.
I want to emphasise that I would not use the Recordset of the subform. Use the RecordSource. You can set it to a SQL statement and/or filter records. Using the Recordset property is problematic (and unnecessary).

Related

Me.Requery appears to be doing no action on form

I have searched and have found a lot of information on using requery on a subform, but I can't seem to find anything that indicates attempting to requery the active form with a new recordset.
I have a form based on a query. I am using an unbound text box to capture the address which needs to be searched then changing the sql statement in the query to locate the records then attempting to use me.requery to load the new results.
The code is updating the sql statement, but the form is not requerying with the new record results. My code is below.
I am fairly new to access and VBA, and appreciate any wisdom you may have. Also, is there ANYTHING that I could be doing in other code which would cause this to fail?
Private Sub Command51_Click()
Dim d As DAO.Database
Dim q As DAO.QueryDef
Dim Addy As String
Dim Search As String
Set d = CurrentDb()
Set q = d.QueryDefs("SQL_Search")
If IsNull(Me!Addy) Then
MsgBox ("Please select a valid address from the list and try again.")
GoTo CleanUp
Else: End If
Addy = Me!Addy
Search = "select * from dbo_ECNumberVerify Where (((dbo_ECNumberVerify.invalidrecord)=False) AND ((dbo_ECNumberVerify.updated)=False) AND ((dbo_ECNumberVerify.Locations) Like '*" & Addy & "*'));"
'Send SQL SP execute command.
q.SQL = Search
Me.Requery
CleanUp:
Set q = Nothing
Set db = Nothing
End Sub
In your example you have a query, but the query is never set or attached to the forms record source in "any way". So the “query” acts independent from the form data source.
You can simply stuff the sql directly into the forms reocrdsouce like this:
Me.RecordSource = Search
(so you don’t need all of your existing code, nor do you need the queryDef.
And when you set the forms SQL directly as per above, then a requery is done automatic for you. So the code required will look like this:
Dim strSearch As String
If IsNull(Me.Addy) Then
MsgBox ("Please select a valid address fromthe list and try again.")
Exit Sub
End If
strSearch = "select * from dbo_ECNumberVerify WHERE " & _
"(invalidrecord = False) AND (updated = False) AND " _
"(Locations Like '*" & Addy & "*')"
Me.RecordSource = strSearch
So you don't need much code, and you really don't need to use + declare the querydef at all.

Get Record based on form textbox value

I am trying to get a record based on the value contain within the textbox on a form. i.e i type in the information into the textbox and other values associated with that value are returned to other textbox on the form.
I thought this would be easy but can't seem to get it to work.
Currently I was trying
Dim rst As DAO.Recordset
Dim SQL As String
Dim SQL2 As String
SQL = "SELECT tblmytbl.[IDCODE]"
"FROM tblmytbl " & _
"WHERE (((tblmytbl.[IDCODE]) = forms!myform!mybox.value "
Set db = CurrentDb
Set rst = db.OpenRecordset(SQL)
If Not ((rst.BOF = True) And (rst.EOF = True)) Then
Forms!myform!Text102 = rst.Fields("[Name]")
Forms!myform!Text103 = rst.Fields("[Surname]")enter code here
Note: The search information is alphanumeric and i have tried without the .value
Any help would be appreciated.
Thanks
The SQL you send to the server can't access the form. However, you can concatenate the value into the string that you send like:
" WHERE (((mytable.myfield) = '" & FixQuotes(Forms!myform!mybox.value) & "') " & _
Note, you may need to defend yourself against SQL injection, a simple (but not complete) defense would be something like:
Public Function FixQuotes(input as string) As String
FixQuotes = Replace(input,"'","''")
End Function
EDIT:
Based on your updated code, there's quite a number of changes you need to make. Beyond my statement above, the .OpenRecordset only applies to full tables, you can't use it with a SELECT statement. Instead, you have to instantiate a QueryDef. On top of that, you try to reference fields you didn't include in the query. Also, you can simplify the expression Forms!myform! to Me (which could help if you want to reuse the code somewhere else) So your code should look something like this:
Dim db as Database 'always dim everything, you should use Option Explicit'
Dim rst as Recordset 'DAO is the default anyway'
Dim qdf as QueryDef 'this object is required for queries'
Set db = CurrentDb
'prepare single-use query, to return the values you're going to use
'as mentioned before, the query doesn't have access to the form
'we can use Me since it references the form'
' use TOP 1 since you only expect 1 record'
Set qdf = db.CreateQueryDef("","SELECT TOP 1 Name,Surname FROM tblmytbl " & _
"WHERE IDCODE = '" & FixQuotes(Me.mybox.value) & "';")
Set rst = qdf.OpenRecordset(DbOpenForwardOnly)
'forwardonly since you only care about the first record'
If Not rst.EOF Then 'ForwardOnly has to start at the first record'
Me.Text102.Value = rst!Name
Me.Text103.Value = rst!Surname
'I highly suggest giving these boxes better names'
Else
'no record found'
End if
rst.Close
qdf.Close
db.Close 'close these objects, it can sometimes cause memory leaks otherwise'

Get recordset from selected records on datasheet

I have a subform with a datasheet view. On the parent form I am trying to edit records based on what is selected in the child datasheet. The forms are not linked using master/child fields.
I'm capable of getting the top row that is selected and the number of selected rows using SelTop and SelHeight like below.
Dim rs As New ADODB.Recordset
Set rs = Me.Child_Form.Form.RecordsetClone
If SelHeight > 0 Then
rs.MoveFirst
rs.Move SelectionTop - 1
For i = 1 To SelectionHeight
If Not rs.EOF Then
Debug.Print rs("ID")
rs.MoveNext
End If
Next i
End If
What I cannot do is get, say, the 10 records selected on the subform if I have filtered or sorted the form at all. The Filters and Sorts are at the form level and cannot be applied to the underlying recordset.
I've tried creating a new recordset with a query something like this
sql = "Select * from [" & Me.RecordSource & "] where " & Replace(Me.Filter, """", "'") & " order by " & Me.OrderBy
but there are multiple problems here. 1) ADO does not support the IN clause which the form filter will sometimes generate, and 2) the order order is not always the same and predictable.
How can I get a sorted, filtered recordset and find only those records which a user has selected in a datasheet view?
I am connecting to Sql Server with an ADP file.
I came up with a frustrating solution but it seems to work.
added an unbound (to my recordset) checkbox control to my subform.
named it chkSelect.
made the controlsource =IsChecked(ID)
I have this code running in the subform
Dim selectedRecords As Dictionary
Private Sub chkSelect_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If selectedRecords.Exists(Me("Analytical_ResultID").Value) Then
selectedRecords.Remove Me("Analytical_ResultID").Value
Else
selectedRecords.Add Me("Analytical_ResultID").Value, Me("Analytical_ResultID").Value
End If
chkSelect.Requery
End Sub
Private Function IsChecked(Analysis_ResultID As Long) As Boolean
IsChecked = selectedRecords.Exists(Analysis_ResultID)
End Function
Private Sub Form_Load()
If selectedRecords Is Nothing Then
Set selectedRecords = New Dictionary
End If
End Sub
This works but it's flickery and not ideal. I would much prefer another answer.

Form hanging while running listbox query

My form is hanging for several seconds every time the user goes to a new record. The recordset for a listbox on the form is a query. The form is hanging until that query finishes and the listbox is populated.
My users need to be able to scroll through the records quickly. Currently, the user must wait for the listbox query to finish before moving to the next record. How can I stop the form from hanging?
Is there a way for DoEvents to be used to solve this problem?
Below is my code. I suspect that seeing all this code is not necessary, but I am sharing it all just in case.
I am using Access.
Thanks!
Option Compare Database 'Use database order for string comparisons
Option Explicit
Dim QuoteLogForm As Form
Public KeystrokeCount As Integer
'Define the similarity threshold for the matches list
Const SIMIL_THRESHOLD As Single = 0.83
Private m_strDialogResult As String
'The basis of this code was derived from http://www.accessmvp.com/tomvanstiphout/simil.htm
Private Sub Form_Current()
Matches
End Sub
Private Sub Matches()
'This sub calls the functions necessary to generate a query that lists
'the KFC RFQ #'s whose similarity exceeds the threashold, as defined above.
Dim sql As String
Dim strOpenArgs As String
Dim strInClause As String
'OpenArgs contains the part # to find similars for.
strOpenArgs = Replace(Replace(Nz(Me.Part_Number_Textbox.Value), "-", ""), " ", "") 'Nz changes Nulls to blanks
'Call the GetSimilarPartNos function below.
'This function returns a string of KFC RFQ #'s that exceed the threashold, wrapped in single quotes and separated by commas.
strInClause = GetSimilarPartNos(strOpenArgs)
'If any similar part numbers were found, run a query to select all the listed records
If VBA.Len(strInClause) > 0 Then
'Select records whose KFC RFQ #'s are found in the strInClause list, sort from most to least similar
sql = "select * from [Matches List Query] where [KFC RFQ #] in (" & strInClause & ")" ' order by SimilPct desc, DateShort desc"
'[Forms]![Price Form Parent]![Price Form].[Form].Customer_Filter_Box
Set Me.[Matches List Form].Form.Recordset = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
Else
'If no similar KFC RFQ #'s were found, select no records
sql = "select * from [Matches List Query] where 1 = 0"
Set Me.[Matches List Form].Form.Recordset = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
End If
End Sub
Private Function GetSimilarPartNos(ByVal strPartNo As String) As String
'The GetSimilarPartNos function calls the fnSimil function and compiles a list (strInClause)
'of KFC RFQ #'s whose part numbers exceed the threashold
Dim rs As DAO.Recordset
Dim strInClause As String
Dim sngSimil As Single
'Erase all previous values in the [Quote Log].Simil field
CurrentDb.Execute "update [Quote Log] set Simil = 0", dbFailOnError
Set rs = CurrentDb.OpenRecordset("Quote Log") ', dbOpenTable)
'Loop to calculate the similarity of all part numbers
While Not rs.EOF 'Loop until the end
Dim curPartNo As String
curPartNo = Replace(Replace(Nz(rs![Part #]), "-", ""), " ", "")
If rs![KFC RFQ #] = Me.[KFC RFQ #] Then
GoTo 120
End If
sngSimil = fnSimil(curPartNo, strPartNo)
'If the part number similarity value of a single record is greater than the
'threashold (as defined above), add the record's KFC RFQ # to strInClause
'strInClause forms a list of KFC RFQ #'s whose part numbers exceed the threashold
'in similarity, wrapped in single quotes and separated by commas
If sngSimil >= SIMIL_THRESHOLD Then
strInClause = strInClause & "'" & rs![KFC RFQ #] & "',"
'Show the Simil value on this form
rs.Edit
rs!Simil = sngSimil
rs.Update
End If
120 rs.MoveNext
Wend
rs.Close
Set rs = Nothing
'Once the strInClause is completed, remove the last comma from the list
If Len(strInClause) > 0 Then strInClause = VBA.Left$(strInClause, Len(strInClause) - 1)
GetSimilarPartNos = strInClause
End Function
The UI is hanging because the work is being done by the UI thread. If you want (or need) a more responsive application, you need to offload the work to a background thread. As far as I know, for VBA, that is not something for the feint of heart, but you can take a look, VBA + Threads in MS Access.
As access is a database, it suffers from all the drawbacks of any database, mainly finding data stored on slow, usually spinning, media. I suggest you take a look at this article: Create and use an index to improve performance to help you create efficient indexes for your queries, if you have not indexed for them already. You also need to consider the performance implications of WHERE, JOIN, and ORDER BY clauses in your queries. Make sure your indexes are optimized for your queries and your data is stored in a logical fashion for the way it will be queries out. Beyond that, if the database does not reside on the machine from which the queries are being executed, you have network I/O latency on top of expected Disk I/O latency. This can significantly impact the read performance of the database.
I think you might possibly have the wrong form event.
The form_Current event fires between each record and I can't imagine that's what you really need. Try moving your "Matches" routine into the OnLoad event instead.

VBA and Access Form Filter

I have this form in access, the purpose of it is to work as a front end of a table which can be edited through this form. Initially when it loads I display in the form data from a recordset with the following query:
SELECT * FROM DATA
I want to be able to filter the data on the recordset once the form is open. I tried the following VBA code to accomplish this:
Private Sub Filter_Click()
If (IsNull(Me.Find_Field) Or Me.Find_Field = "") Then
rs.Close
Set rs = db.OpenRecordset("Select * from DATA ORDER BY ID)
rs.MoveFirst
LoadData (True)
Exit Sub
End If
Set rs = db.OpenRecordset("Select * from DATA WHERE ID = " & Me.Find_Field)
rs.MoveFirst
LoadData (True) ' Function that loads the data into the form
Exit Sub
As you all can see, I reload the recordset with a new filtered query. Up to this point it works, the problems begin when I try to modify a record.
Originally, when the form loads the recordset data, I am able to edit the data and the edited data would show in the table (which is what I want). But after I apply my filter, my code gives me the Run-Time error '3027': Cannot Update. Databse or object is read-only.
I am pretty much using the same code over and over to reload data from the table and it never gave me a problem until I 'overwrote' the source of the recordset. Any idea how can I resolve this issue? Thanks
I would prefer to use a standard Access bound form because it's simpler than what you appear to be doing.
I can change the form's RecordSource from the click event of my cmdApplyFilter button.
Private Sub cmdApplyFilter_Click()
Dim strSql As String
If Len(Me.txtFind_Field & vbNullString) > 0 Then
strSql = "SELECT * FROM tblFoo WHERE id = " & _
Me.txtFind_Field & " ORDER BY id;"
Me.RecordSource = strSql
End If
End Sub
If you're concerned someone might save the form with the filtered RecordSource, you can make the form always open with the unfiltered version.
Private Sub Form_Open(Cancel As Integer)
Dim strSql As String
strSql = "SELECT * FROM tblFoo ORDER BY id;"
Me.RecordSource = strSql
End Sub