Building string based on combination of checked checkboxes - ms-access

On a form I have 3 checkboxes - chk1, chk2, & chk3.
The where clause of an SQL statement will be built, based on what combination of boxes are ticked.
So, if only chk1 is checked I need my string to be :-
where x=1
But if chk1 and chk2 are checked, I need my string to be :-
where x=1 or x=2
What is the best approach to build the string? I've tried nested ifs, but it seems very messy, and I'm sure there must be a better approach.

The usual way I build SQL clauses is the following way:
Dim strWhere As String
strWhere = "WHERE 1=1" 'Always true
If chk1 Then
strWhere = strWhere & " OR x=1"
End If
If chk2 Then
strWhere = strWhere & " OR x=2"
End If
If chk3 Then
strWhere = strWhere & " OR x=3"
End If
strWhere = Replace(strWhere, "1=1 OR ", "") 'Remove always true if something has been set
This way, you can easily extend the where clause by adding extra criteria.
In this case, though, since you're only comparing a single value, I'd use the following:
Dim strWhere As String
strWhere = "WHERE x IN (Null" 'In(Null) is valid, but will return Null = false if null and false if any other value
If chk1 Then
strWhere = strWhere & ",1"
End If
If chk2 Then
strWhere = strWhere & ",2"
End If
If chk3 Then
strWhere = strWhere & ",3"
End If
strWhere = strWhere & ")"
These will behave differently when none are checked. The first approach will return everything in that case, the second none.

Related

Searching function for textbox and letting my function still run when there are none entries in for the textbox and listbox

All I really need to know is how to make it where I can make selections in multiple multi-select listboxes, but leave any number of them blank and still have the macro/query work without having to put in an error message about it.
This also includes doing the same with the textboxes. The textboxes would function the same as the listboxes where they would search for anything in a data table to matches what I am looking for in the records and display what I am looking for in a table.
Here is my code
Private Sub Command62_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim District As String
Dim Circumstance As String
Dim Location As String
Dim Method As String
Dim Point As String
Dim Rank As String
Dim strSQL As String
Set db = CurrentDb()
Set qdf = db.QueryDefs("qryMultiselect")
For Each varItem In Me!District.ItemsSelected
District = District & ",'" & Me!District.ItemData(varItem) & "'"
Next varItem
If Len(District) = 0 Then
MsgBox "You did not select anything in the Distrcit field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
District = Right(District, Len(District) - 1)
For Each varItem In Me!Circumstance.ItemsSelected
Circumstance = Circumstance & ",'" & Me!Circumstance.ItemData(varItem) &
"'"
Next varItem
If Len(Circumstance) = 0 Then
MsgBox "You did not select anything in the Circumstance field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Circumstance = Right(Circumstance, Len(Circumstance) - 1)
For Each varItem In Me!Location.ItemsSelected
Location = Location & ",'" & Me!Location.ItemData(varItem) & "'"
Next varItem
If Len(Location) = 0 Then
MsgBox "You did not select anything in the Location field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Location = Right(Location, Len(Location) - 1)
For Each varItem In Me!Method.ItemsSelected
Method = Method & ",'" & Me!Method.ItemData(varItem) & "'"
Next varItem
If Len(Method) = 0 Then
MsgBox "You did not select anything in the Method field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Method = Right(Method, Len(Method) - 1)
For Each varItem In Me!Point.ItemsSelected
Point = Point & ",'" & Me!Point.ItemData(varItem) & "'"
Next varItem
If Len(Point) = 0 Then
MsgBox "You did not select anything in the Point field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Point = Right(Point, Len(Point) - 1)
For Each varItem In Me!Rank.ItemsSelected
Rank = Rank & ",'" & Me!Rank.ItemData(varItem) & "'"
Next varItem
If Len(Rank) = 0 Then
MsgBox "You did not select anything in the Rank field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Rank = Right(Rank, Len(Rank) - 1)
strSQL = "SELECT * FROM tblDataEntry " & _"WHERE tblDataEntry.District
IN(" & District & ") AND tblDataEntry.Circumstance IN(" & Circumstance &
") AND tblDataEntry.Location IN(" & Location & ") AND tblDataEntry.Method
IN (" & Method & ") AND tblDataEntry.Point IN (" & Point & ") AND
tblDataEntry.Rank IN(" & Rank & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "qryMultiselect"
Set db = Nothing
Set qdf = Nothing
End Sub
I still need to add the textboxes, but I'm not sure where. (Please note that I'm still learning VBA).
Firstly, since you are repeatedly performing the same operation for each form control (in this case, constructing a comma-delimited string from the selected items), you can abstract this operation away into a function, and pass such function each List Box function.
For example, you could define a function such as:
Function SelectedItems(objBox As ListBox) As String
Dim strRtn As String, varItm
For Each varItm In objBox.ItemsSelected
strRtn = strRtn & ",'" & objBox.ItemData(varItm) & "'"
Next varItm
If strRtn <> vbNullString Then SelectedItems = Mid(strRtn, 2)
End Function
Which could then be evaluated with a List Box control argument, and would return either a null string ("") or a comma-delimited string of the selected items in the list box, e.g. something like:
?SelectedItems(Forms!Form1!List1)
'A','B'
Furthermore, since your form controls appear to be named consistently relative to the fields in your table, you could further condense your code to something along the following lines:
Private Sub Command62_Click()
Dim strSQL As String
Dim strArr As String
Dim varItm
For Each varItm In Array("District", "Circumstance", "Location", "Method", "Point", "Rank")
strArr = SelectedItems(Me.Controls(varItm))
If strArr <> vbNullString Then
strSQL = strSQL & "t." & varItm & " in (" & strArr & ") and "
End If
Next varItm
If strSQL <> vbNullString Then strSQL = "where " & Left(strSQL, Len(strSQL) - 5)
With CurrentDb.QueryDefs("qryMultiselect")
.SQL = "select * from tblDataEntry t " & strSQL
End With
DoCmd.OpenQuery "qryMultiselect"
End Sub
Note that the above is entirely untested.
Here, the main for each loop iterates over an array of strings corresponding to the names of your form controls and the names of your table fields.
For each form control in this array, the function obtains a comma-delimited string of the selected items in the control, and concatenates this with the existing SQL code only if one or more items have been selected.
As such, if not items are selected, the field will not feature in the SQL where clause.
If any filter has been selected, the trailing five characters (and) are trimmed from the end of the SQL string, and the where keyword is concatenated to the start of the SQL string - this ensures that if no filter has been selected, the resulting SQL code will not include a where clause.
Finally, the SQL for the query definition is updated and the query is opened, per your original code.
Where textboxes are concerned, the task merely need to skip the call to SelectedItems and obtain the value of the textbox directly.
Here is an example incorporating both listboxes & textboxes:
Private Sub Command62_Click()
Dim strSQL As String
Dim strArr As String
Dim varItm
For Each varItm In Array("District", "Circumstance", "Location", "Method", "Point", "Rank")
strArr = vbNullString
Select Case Me.Controls(varItm).ControlType
Case acListBox
strArr = SelectedItems(Me.Controls(varItm))
Case acTextBox
If Not IsNull(Me.Controls(varItm).Value) Then
strArr = "'" & Me.Controls(varItm).Value & "'"
End If
End Select
If strArr <> vbNullString Then
strSQL = strSQL & "t." & varItm & " in (" & strArr & ") and "
End If
Next varItm
If strSQL <> vbNullString Then strSQL = "where " & Left(strSQL, Len(strSQL) - 5)
With CurrentDb.QueryDefs("qryMultiselect")
.SQL = "select * from tblDataEntry t " & strSQL
End With
DoCmd.OpenQuery "qryMultiselect"
End Sub
I hope this helps, but please note that the above is untested and only theory.

Access VBA Filtering code Syntax Error issue

I have the code below (courtesy of allenbrowne, his info are in the code). When I am filtering using one of the columns (One_or_Two_Pearl) it is giving me a (Syntax error missing operator in query expression). I can not trace the problem as everything look fine. That column is defined as Text type and contains data (1, 2, NA). This problem is only occurring for this column, and when I debug the yellow mark is indicating the (Me.Filter = strWhere) part.
Thank you in advance for your help.
'http://allenbrowne.com/ser-62.html
'Purpose: This module illustrates how to create a search form, _
where the user can enter as many or few criteria as they wish, _
and results are shown one per line.
'Note: Only records matching ALL of the criteria are returned.
'Author: Allen Browne (allen#allenbrowne.com), June 2006.
Option Compare Database
Option Explicit
Private Sub cmdFilter_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.
'***********************************************************************
'Look at each search box, and build up the criteria string from the non-blank ones.
'***********************************************************************
'Text field example. Use quotes around the value in the string.
If Not IsNull(Me.cboxprojphase) Then
strWhere = strWhere & "([Project_Phase] = """ & Me.cboxprojphase & """) AND "
End If
'Another text field example. Use Like to find anywhere in the field.
If Not IsNull(Me.cboxcontract) Then
strWhere = strWhere & "([Contract] = """ & Me.cboxcontract & """) AND "
End If
'Number field example. Do not add the extra quotes.
If Not IsNull(Me.cboxdesigndpm) Then
strWhere = strWhere & "([Design_DPM] = """ & Me.cboxdesigndpm & """) AND "
End If
'Text field example. Use quotes around the value in the string.
If Not IsNull(Me.cboxadmupc) Then
strWhere = strWhere & "([ADM/UPC] = """ & Me.cboxadmupc & """) AND "
End If
'Text field example. Use quotes around the value in the string.
If Not IsNull(Me.cboxpearl) Then
strWhere = strWhere & "([One_or_Two_Pearl] = """ & Me.cboxpearl & """) "
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 cmdReset_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
ctl.Value = Null
Case acCheckBox
ctl.Value = False
End Select
Next
'Remove the form's filter.
Me.FilterOn = False
Me.OrderByOn = False
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 Records 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
Dim strURL As String
Dim objIE As Object
Dim arrSites(2) As String
Dim i As Integer
arrSites(0) = "http://google.com"
arrSites(1) = "http://google.com"
Set objIE = CreateObject("InternetExplorer.Application")
For i = 0 To 1 Step 1
strURL = arrSites(i)
If i = 0 Then
objIE.Navigate strURL
Else
objIE.Navigate2 strURL, 2048
End If
Next i
objIE.Visible = True
Set objIE = Nothing
'objIE.Quit
End Sub
Private Sub optSortorder_AfterUpdate()
If Me.optSortorder = 1 Then
Me.OrderBy = Me.cboSortField
Else
Me.OrderBy = Me.cboSortField & " DESC"
End If
Me.OrderByOn = True
End Sub
Both your problems are here:
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line. Prints to Immediate Window (Ctrl+G).
'Debug.Print strWhere
Uncomment the Debug.Print line to see what is happening:
it tries to remove a trailing " AND " from your [One_or_Two_Pearl] line, but there is none.

Creating a form to search for records based on multiple criteria

I am trying to create a form that allows you to return results based on multiple criteria.
I have FirstName field, LastName field, and State Field.
I also have an text boxes named searchFirst, searchLast, searchState where users can input criteria.
The search button will execute the following code once clicked.
Private Sub mySearchQuery_Click()
Dim filter As String
Dim rtFirstName As String
Dim rtLastName As String
Dim rtState As String
rtFirstName = Me.searchFirst.Value
rtLastName = Me.searchLast.Value
rtState = Me.searchState.Value
If Not IsNull(rtFirstName) Then
If Not IsNull(filter) Then filter = filter & " AND "
filter = filter & "(FirstName like""*" & rtFirstName & "*"")"
End If
If Not IsNull(rtLastName) Then
If Not IsNull(filter) Then filter = filter & " AND "
filter = filter & "(LastName like""*" & rtLastName & "*"")"
End If
If Not IsNull(rtState) Then
If Not IsNull(filter) Then filter = filter & " AND "
filter = filter & "(State LIKE""*" & rtState & "*"")"
End If
' Now re-construct the SQL query '
Dim sql As String
sql = "SELECT * FROM MainData"
If Not IsNull(filter) Then
sql = sql & " WHERE " & filter
End If
Me.RecordSource = sql
'SubForm.Form.RecordSource = sql
End Sub
I am getting the following error below.
Run-time error '3075': Syntax error (missing operator) in query
expression 'AND (FirstName like"*tracy*") AND (lastName like"*Smith*")
AND (State LIKE"*ga*")'.
I am not sure why AND was included at the beginning of the search query?
I am not sure why AND was included at the beginning of the search
query?
Since you have Dim filter As String, filter can never contain Null. That means these If conditions ... If Not IsNull(filter) ... will always be True.
Similarly, Not IsNull(rtFirstName), Not IsNull(rtLastName), and Not IsNull(rtState) will always be True.
The net result is the code adds another condition piece to your filter string regardless of whether or not the corresponding search text box contains anything, and each of those pieces is prefixed with " AND ".
With those points in mind, you could refactor your code to add a filter segment only when you have something in the corresponding search text box and decide when to include " AND ". However I find it simpler to include " AND " for each of them and then strip away the very first " AND " from filter before adding it to the WHERE clause.
Private Sub mySearchQuery_Click()
Dim strSelect As String
Dim strWhere As String
If Len(Trim(Me!searchFirst.Value) & vbNullString) > 0 Then
strWhere = strWhere & " AND FirstName Like ""*" & Me!searchFirst.Value & "*"""
End If
If Len(Trim(Me!searchLast.Value) & vbNullString) > 0 Then
strWhere = strWhere & " AND LastName Like ""*" & Me!searchLast.Value & "*"""
End If
If Len(Trim(Me!searchState.Value) & vbNullString) > 0 Then
strWhere = strWhere & " AND State Like ""*" & Me!searchState.Value & "*"""
End If
' Now re-construct the SQL query
strSelect = "SELECT * FROM MainData"
' only add WHERE clause if we have something in strWhere
If Len(strWhere) > 0 Then
' use Mid() to ignore leading " AND "
strSelect = strSelect & " WHERE " & Mid(strWhere, 6)
End If
Debug.Print strSelect ' <- inspect this in Immediate window; Ctrl+g will take you there
' enable one of these RecordSource lines after confirming Debug.Print shows you what you need
'Me.RecordSource = sql
'SubForm.Form.RecordSource = sql
End Sub

Export data from continuous form to Excel w/o header fields

I have a continuous form, where the form header contains filter options, and the details section contains the data.
I want to be able to export this to excel. the basic VBA code works
DoCmd.OutputTo
but when I export to Excel, it also includes the form header controls for each row.
Is there any way to set a property that will exclude the form header from being included in the export? Basically, only export the form details section?
I prefer not to use a query
I have 6 unbound txt boxes in the header:
- artnr
- Artnr supplier
- description
- article status
- supplier name
- supplier number
and i have a search button, wich holds this code:
Private Sub cmdSearch_Click()
Dim strWhere As String
Dim lngLen As Long
'artikel zoeken
If Not IsNull(Me.txtSearchArtnr) Then
strWhere = strWhere & "([Material] Like ""*" & Me.txtSearchArtnr & "*"") AND "
End If
'artnr leverancier zoeken
If Not IsNull(Me.txtSearchSupplArt) Then
strWhere = strWhere & "([LiefMat] Like ""*" & Me.txtSearchSupplArt & "*"") AND "
End If
'trefwoord zoeken
If Not IsNull(Me.txtSearchKeyword) Then
strWhere = strWhere & "([Materialkurztext] Like ""*" & Me.txtSearchKeyword & "*"") AND "
End If
'artikelstatus zoeken
If Not IsNull(Me.txtSearchStatus) Then
strWhere = strWhere & "([Status] Like ""*" & Me.txtSearchStatus & "*"") AND "
End If
'leverancier naam zoeken
If Not IsNull(Me.txtSearchSupplName) Then
strWhere = strWhere & "([Name 1] Like ""*" & Me.txtSearchSupplName & "*"") AND "
End If
'leverancier nummer zoeken
If Not IsNull(Me.txtSearchSupplNumber) Then
strWhere = strWhere & "([Lieferant] Like ""*" & Me.txtSearchSupplNumber & "*"") 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 "Geen criteria gevonden", vbInformation, "Geen resultaten."
Else 'Yep: there is something there, so remove the " AND " at the end.
strWhere = Left$(strWhere, lngLen)
'Apply the string as the form's Filter.
Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub
I found the sollution here:
Exporting selected records to excel - hiding certain columns
DoCmd.Echo False
Me.Field1.Visible = False
Me.Field2.Visible = False
Me.Field3.Visible = False
DoCmd.RunCommand acCmdOutputToExcel
Me.Field1.Visible = True
Me.Field2.Visible = True
Me.Field3.Visible = True
DoCmd.Echo True
End Sub
it's simple and it works for me
you write, that users can set filters, so you must have programmed something like
Me.RecordSource = "SELECT ... FROM table WHERE --here the criterias--"
Me.Requery
so you could take the SQL-Statement and use it for export, you first have to create a query
Dim sSQL As String
Dim qd As QueryDef
Set qd = CurrentDb.CreateQueryDef("tmp_Query")
qd.SQL = "Select * from T_Personal"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "tmp_Query", "yourfile", True
CurrentDb.QueryDefs.Delete qd.Name
wrap it into a function, so you can fire it anywhere and pass the sql and filename ...
HTH

Dcount on multiselect listbox?

Me again. This code works fine when only 1 item is selected, however when more than one item is selected I get the error "syntax error (comma) in query expression" on the following line of code:
intCountNull = DCount("*", "Scrubbed", strCriteria & " Is Null")
Here is my code:
Private Sub Command29_Click()
Dim strCriteria As String
Dim intCountNull As Integer
Dim varItem As Variant
'On Error GoTo Err_Command29_Click
Me.Fields_Values.RowSource = ""
For Each varItem In Me!List101.ItemsSelected
strCriteria = strCriteria & "," & Me!List101.ItemData(varItem)
Next varItem
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
intCountNull = DCount("*", "Scrubbed", strCriteria & " Is Null")
Fields_Values.RowSource = intCountNull & " null values found in " & strCriteria
Exit_Command29_Click:
Exit Sub
'Err_Command29_Click:
'MsgBox "Please select a field"
End Sub
... when more than one item is selected I get the error "syntax error (comma) in query expression" on the following line of code: intCountNull = DCount("*", "Scrubbed", strCriteria & " Is Null")
That makes sense. If the list box selections were "field1", "field3", and "field4", your DCount() would throw error #3075, "Syntax error (comma) in query expression 'field1,field3,field4 Is Null'."
The DCount() expression would be evaluated like this SELECT statement:
SELECT Count(*)
FROM Scrubbed
WHERE field1,field3,field4 Is Null
And the db engine will definitely complain about that WHERE clause. You can't give it a list of field names and ask it whether the list Is Null. You would have to separately ask whether each field Is Null.
That is the explanation for why you get that error. However, I think you need to change your approach.
Build up the RowSource value list string for Fields_Values as you iterate through List101 selected items. (Make sure you have Value List as the Row Source Type property for Fields_Values.) Here is a tested sample which does what I think you want.
Private Sub Command29_Click()
Dim strCriteria As String
Dim intCountNull As Integer
Dim varItem As Variant
Dim strRowSource As String
Me.Fields_Values.RowSource = ""
For Each varItem In Me!List101.ItemsSelected
strCriteria = "[" & Me!List101.ItemData(varItem) & _
"] Is Null"
intCountNull = DCount("*", "Scrubbed", strCriteria)
'Debug.Print strCriteria, intCountNull '
strRowSource = strRowSource & ";" & intCountNull & _
" null values found in " & _
Me!List101.ItemData(varItem)
Next varItem
'Debug.Print strRowSource '
If Len(strRowSource) > 0 Then
strRowSource = Mid(strRowSource, 2)
Me.Fields_Values.RowSource = strRowSource
End If
'Debug.Print strRowSource '
End Sub
Also I don't see why the user should even be allowed to click Command29 unless List101 contains selected items. So consider disabling Command29 until selections have been made.
Private Sub Form_Load()
Me.Command29.Enabled = False
End Sub
Private Sub List101_AfterUpdate()
Me.Command29.Enabled = (Me.List101.ItemsSelected.Count > 0)
End Sub
Finally, I'll suggest you do yourself a favor by giving your controls meaningful names ... Command29 could be cmdShowNullCounts and List101 could be lstFieldNames. Meaningful names are especially helpful when you're dealing with dozens of controls. You should also find them helpful when you need to revisit the form design after a few months. Anyone else who has to take over in the future will appreciate your courtesy.