I am creating a form on Access to filter a Subform based on the Column name "Control Type".
I am using a listbox to choose multiple values to filter with.
I also have a button that will execute the filter to the form.
I wrote this code:
Private Sub cmdSearch_Click()
Dim varItem As Variant
Dim strSearch As String
Dim Task As String
For Each varItem In Me!listControl.ItemsSelected
strSearch = strSearch & "," & Me!listControl.ItemData(varItem)
Next varItem
If Len(strSearch) = 0 Then
Task = "select * from tblAB"
Else
strSearch = Right(strSearch, Len(strSearch) - 1)
Task = "select * from tblAB where Control_Type = '" & strSearch & "' "
End If
Me.tblAB_subform.Form.Filter = Task
Me.tblAB_subform.Form.FilterOn = True
End Sub
I am getting a Run=time error '3075' for the line:
Task = "select * from tblAB where Control_Type = '" & strSearch & "' "
Run time error must not be on refered line.
From documentation:
The Filter property is a string expression consisting of a WHERE
clause without the WHERE keyword.
So is not a complete SELECT sentence, but just:
Task = "Control_Type = '" & strSearch & "'"
Related
I have problem running this code. It gives me Syntax error (missing operator) in query expression
Function SearchCriteria()
Dim class,StateProvince,strAcademicYear As As String
Dim task, strCriteria As String
If isNull(Forms!frmStudentList!cboClass) Then
Class = "[Class] LIKE '*' "
Else
Class = [Class] = " & Forms!frmStudentList!cboClass
End If
If isNull(Forms!frmStudentList!cboStateProvince) Then
StateProvince = "[StateProvince] LIKE '*' "
Else
StateProvince = [StateProvince] = " &
Forms!frmStudentList!cboStateProvince
End If
If isNull(Forms!frmStudentList!cboAcademicYear) Then
StrAcademicYear = "[AcademicYear] LIKE '*' "
Else
StrAcademicYear = [AcademicYear] = '" &
Forms!frmStudentList!cboAcademicYear & "'"
End If
strCriteria = Class & "AND" & StateProvince & "AND" & StrAcademicYear
task = "SELECT * FROM QryStudentSearch WHERE & Criteria
Forms!frmStudentList.RecordSource = task
Forms!frmStudentList.Requery
End Function
There are quite a few problems with this piece of code.
Firstly, most of your variables aren't explicitly declared as being of a type, so default to being Variant.
Next, Class is a reserved word in Access, and will probably cause you problems.
If a control has no choice made, you are using LIKE '*' to select data. There is no need to do this, as by applying no filter means that all records will be returned anyway.
As it doesn't return a value, you can create this as a Sub rather than a Function.
The main problem is with how you are concatenating the different parts together.
I would rewrite the code as:
Sub sSearch()
Dim strSearch As String
If Not IsNull(Forms!frmStudentList!cboClass) Then
strSearch = strSearch & " AND [Class]='" & Forms!frmStudentList!cboClass & "' "
End If
If Not IsNull(Forms!frmStudentList!cboStateProvince) Then
strSearch = strSearch & " AND [StateProvince]='" & Forms!frmStudentList!cboStateProvince & "' "
End If
If Not IsNull(Forms!frmStudentList!cboAcademicYear) Then
strSearch = strSearch & " AND [AcademicYear]='" & Forms!frmStudentList!cboAcademicYear & "' "
End If
If Left(strSearch, 4) = " AND" Then
strSearch = "WHERE " & Mid(strSearch, 6)
End If
strSearch = "SELECT * FROM qryStudentSearch " & strSearch
Forms!frmStudentList.RecordSource = strSearch
Forms!frmStudentList.Requery
End Sub
In each case, I am assuming that the bound column of each combo box is text, hence the need to use single quotes around the data. If the bound column is numeric, then the single quotes can be removed.
Regards,
I'm trying to filter a splitform with a listbox but I keep getting the error '3075'.
I used the debug tool and I got:
strSearch = "52185A, 515674B"
Task = "select * from tOrder where ([OrderID] in (52185A,515674B))"
I'm pretty sure I'm missing some quotations, however I couldn't seem to figure out where. They're all short text format.
Option Compare Database
Private Sub cmdSearch_Click()
Dim varltem As Variant
Dim strSearch As String
Dim Task As String
For Each varltem In Me!LstMatricule.ItemsSelected
strSearch = strSearch & "," & Me!LstMatricule.ItemData(varltem)
Next varltem
If Len(strSearch) = 0 Then
Task = "select * from tOrder"
Else
strSearch = Right(strSearch, Len(strSearch) - 1)
Task = "select * from tOrder where ((OrderID] in (" & strSearch & "))"
End If
DoCmd.ApplyFilter Task
End Sub
strSearch = strSearch & ",'" & Me!LstMatricule.ItemData(varltem) & "'"
It is difficult to see but basically I added single quotes around each varItem. You want the result to look like this:
strSearch = "'52185A', '515674B'"
Personally I would do this:
strSearch = strSearch & IIf(Len(strSearch) = 0, "", ",") & "'" & Me!LstMatricule.ItemData(varltem) & "'"
It is slightly more expensive computationally if you have more than 2-3 IDs to add but cleaner than removing the starting comma at the beginning later on.
I use the following code in vba access to update a column of a table, but it is not working. Please help me.
Best regards.
Dim sqlupdate As String
sqlupdate = "UPDATE Assay" _
& "SET Assay.assay_repeat = " & 0 & "" _
& "WHERE (((Assay.[assay_repeat])= " & 1 & "));"
DoCmd.RunSQL sqlupdate
You have an extra double quote and are missing a couple of spaces - try it like this:
Dim sqlupdate As String
sqlupdate = "UPDATE Assay" _
& " SET Assay.assay_repeat = " & 0 & " _
& " WHERE (((Assay.[assay_repeat])= " & 1 & "));"
You just missed space chars at end of the table name and before where.
Dim sqlupdate As String
sqlupdate = "UPDATE Assay " _
& "SET Assay.assay_repeat = " & 0 & " " _
& "WHERE (((Assay.[assay_repeat])= " & 1 & "));"
Here is a great way to convert a SQL string to VBA code.
Creating the form
The form just needs two text boxes, and a command button. SQL statements can be quite long, so you put the text boxes on different pages of a tab control.
Create a new form (in design view.)
Add a tab control.
In the first page of the tab control, add a unbound text box.
Set its Name property to txtSql.
Increase its Height and Width so you can see many long lines at once.
In the second page of the tab control, add another unbound text box.
Name it txtVBA, and increase its height and width.
Above the tab control, add a command button.
Name it cmdSql2Vba.
Set its On Click property to [Event Procedure].
Click the Build button (...) beside this property.
When Access opens the code window, set up the code like this:
Private Sub cmdSql2Vba_Click()
Dim strSql As String
'Purpose: Convert a SQL statement into a string to paste into VBA code.
Const strcLineEnd = " "" & vbCrLf & _" & vbCrLf & """"
If IsNull(Me.txtSQL) Then
Beep
Else
strSql = Me.txtSQL
strSql = Replace(strSql, """", """""") 'Double up any quotes.
strSql = Replace(strSql, vbCrLf, strcLineEnd)
strSql = "strSql = """ & strSql & """"
Me.txtVBA = strSql
Me.txtVBA.SetFocus
RunCommand acCmdCopy
End If
End Sub
http://allenbrowne.com/ser-71.html
I recommend you use Recordsets.
Private Sub Update_My_Records(Parent As Object)
Dim Data_Recset As Object
Dim Parent_Reference As Object
Set Data_Recset = Parent_Reference.Application.DBEngine.Workspaces(0).Databases(0).OpenRecordset("SELECT * FROM Assay WHERE assay_repeat = " & 0 & ";", DB_OPEN_DYNASET)
Data_Recset.MoveLast
Data_Recset.MoveFirst
Data_Recset.Edit
Data_Recset.Fields("assay_repeat") = 1
Data_Recset.Update
Data_Recset.Close
Set Data_Recset = Nothing
End Sub
assumptions
Parent has reference to Access.Application. (I usually pass: Form.Module.Parent reference to Sub/Function)
the table or query "Assay" already exists.
You only need to update 1 row at a time
But if you want to use Queries In Your Form:
Private Sub Query_Definition_Update()
Dim Obj_Qdef As Object
Dim Query_Name As String
Query_Name = "Q_Assay"
Me.Form.Application.DBEngine.Workspaces(0).Databases(0).QueryDefs.Refresh
Set Obj_Qdef = Me.Form.Application.DBEngine.Workspaces(0).Databases(0).QueryDefs(Query_Name)
Obj_Qdef.SQL = Query_Update(1)
Debug.Print Obj_Qdef.SQL
Obj_Qdef.Execute
''When finished updating
Obj_Qdef.Close
Set Obj_Qdef = Nothing
End Sub
'------------------------------------------------------------'
Private Function Query_Update(New_Value as Integer) As String
Query_Update = "UPDATE Assay" & _
" SET Assay.assay_repeat = " & 0 & "" & _
" WHERE (((Assay.[assay_repeat])= " & New_Value & "));"
End Sub
I'm having trouble getting this code to work. I have a blank form with a simple multi-select list box (GroupList) and a button underneath it (cmdSearch). I'm trying to put code into the button to pull select names from GroupList and display Group Affiliation names (field: [Group Affiliations] from table Group_Affiliations.
Private Sub cmdSearch_Click()
Dim varItem As Variant
Dim strSearch As String
Dim Task As String
For Each varItem In Me!GroupList.ItemsSelected
strSearch = strSearch & "," & Me!GroupList.ItemData(varItem)
Next varItem
MsgBox (strSearch)
If Len(strSearch) = 0 Then
Task = "select * from Group_Affiliations"
Else
strSearch = Right(strSearch, Len(strSearch) - 1)
Task = "select * from Group_Affiliations where ([Group Affiliations] in (" & strSearch & "))"
End If
DoCmd.ApplyFilter Task
End Sub
Please help. I think I'm close but it wants me to set a parameter and then I receive the error:
Error code 2501
I think you will likely get the results you want using the following code:
'Set strSearch to empty string
strSearch = ""
'Loop through as you did applying proper single quotes between items
For Each varItem In Me!GroupList.ItemsSelected
strSearch = strSearch & "'" & Me!GroupList.ItemData(varItem) & "',"
Next varItem
'MsgBox (strSearch) 'commented out as I'm sure this is for your testing
'checking if blank (as you did)
If Len(strSearch) = 0 Then
Task = "select * from Group_Affiliations"
'removing end comma and writing SQL statement
Else
strSearch = Left(strSearch, Len(strSearch) - 1)
Task = "select * from Group_Affiliations where ([Group Affiliations] in (" & strSearch & "))"
End If
DoCmd.ApplyFilter Task
If you inspect Task, you will see that the elements of the IN(... part are not quoted. As they are strings (both in VB and for the database, a text field), you must quote the components:
strSearch = strSearch & "'" & Me!GroupList.ItemData(varItem) & "',"
This worked. Thanks billyhoes and everyone! I did show the msgbox because, in this case, I do need viewers to see what they're searching.
Private Sub cmdSearch_Click()
strSearch = ""
For Each varItem In Me!GroupList.ItemsSelected
strSearch = strSearch & "'" & Me!GroupList.ItemData(varItem) & "',"
Next varItem
MsgBox (strSearch)
If Len(strSearch) = 0 Then
Task = "select * from Group_Affiliations"
Else
strSearch = Left(strSearch, Len(strSearch) - 1)
Task = "select * from Group_Affiliations where ([Group Affiliations] in (" & strSearch & "))"
End If
DoCmd.ApplyFilter Task
End Sub
I have the following vba that creates a query in a test Access database. I have two multiple select list boxes. The issue is, i want to be able to select multiple items from "Me![State]" and none from "Me![Animal]" and be able to run the query. However, this is not possible as the query language is not set up to handle that. It makes me select something from "Me![Animal]".
How do i revise the vba below to allow me to query on both multiple selection list boxes if one of the multiple list boxes does not have anything selected or if both have selections in them?
Private Sub Command6_Click()
Dim Q As QueryDef, DB As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant
Dim ctl2 As Control
Dim ctl3 As Control
' Build a list of the selections.
Set ctl = Me![Animal]
For Each Itm In ctl.ItemsSelected
If Len(Criteria) = 0 Then
Criteria = Chr(34) & ctl.ItemData(Itm) & Chr(34)
Else
Criteria = Criteria & "," & Chr(34) & ctl.ItemData(Itm) _
& Chr(34)
End If
Next Itm
If Len(Criteria) = 0 Then
Itm = MsgBox("You must select one or more items in the" & _
" list box!", 0, "No Selection Made")
Exit Sub
End If
Set ctl2 = Me![State]
For Each Itm In ctl2.ItemsSelected
If Len(Criteria2) = 0 Then
Criteria2 = Chr(34) & ctl2.ItemData(Itm) & Chr(34)
Else
Criteria2 = Criteria2 & "," & Chr(34) & ctl2.ItemData(Itm) _
& Chr(34)
End If
Next Itm
If Len(Criteria2) = 0 Then
Itm = MsgBox("You must select one or more items in the" & _
" list box!", 0, "No Selection Made")
Exit Sub
End If
' Modify the Query.
Set DB = CurrentDb()
Set Q = DB.QueryDefs("animalquery")
' Modify the Query.
Set DB = CurrentDb()
Set Q = DB.QueryDefs("animalquery")
Q.SQL = "Select * From [table1] Where [table1].[type] In (" & "'Animal'" & _
")" & " and [table1].[animal] in (" & Criteria & _
")" & " and [table1].[state] in (" & Criteria2 & _
")" & ";"
Q.Close
' Run the query.
DoCmd.OpenQuery "animalquery"
End Sub
EDIT - Fix comparison as per comment
You can do this with a simple check of your Criteria vaiables.
You already do the the length check - just use it later on when you build the dynamic SQL.
I added a strSQL variable to make it easier to track what's happening. And adjusted the error message to allow one or other criteria being empty
Private Sub Command6_Click()
Dim Q As QueryDef
Dim DB As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant
Dim ctl2 As Control
Dim ctl3 As Control
' Use for dynamic SQL statement'
Dim strSQL As String
Set ctl = Me![Animal]
For Each Itm In ctl.ItemsSelected
If Len(Criteria) = 0 Then
Criteria = Chr(34) & ctl.ItemData(Itm) & Chr(34)
Else
Criteria = Criteria & "," & Chr(34) & ctl.ItemData(Itm) & Chr(34)
End If
Next Itm
Set ctl2 = Me![State]
For Each Itm In ctl2.ItemsSelected
If Len(Criteria2) = 0 Then
Criteria2 = Chr(34) & ctl2.ItemData(Itm) & Chr(34)
Else
Criteria2 = Criteria2 & "," & Chr(34) & ctl2.ItemData(Itm) & Chr(34)
End If
Next Itm
If (Len(Criteria) = 0) And (Len(Criteria2) = 0) Then
Itm = MsgBox("You must select one or more items from one of the list boxes!", 0, "No Selection Made")
Exit Sub
End If
' Modify the Query.
Set DB = CurrentDb()
Set Q = DB.QueryDefs("animalquery")
' Modify the Query.
Set DB = CurrentDb()
Set Q = DB.QueryDefs("animalquery")
strSQL = "Select * From [table1] Where [table1].[type] In (" & "'Animal')"
If (Len(Criteria) <> 0) Then ' Append Animal Criteria
strSQL = strSQL & " AND [table1].[animal] IN (" & Criteria & ")"
End If
If (Len(Criteria2) <> 0) Then ' Append State Criteria
strSQL = strSQL & " AND [table1].[state] IN (" & Criteria2 & ")"
End If
Q.SQL = strSQL
Q.Close
' Run the query.
DoCmd.OpenQuery "animalquery"
End Sub