I'm using the following VBA from a friend that works quite well for concatenating items in MS Access.
Public Function ConcatRelated(strField As String, _
strTable As String, _
Optional strWhere As String, _
Optional strOrderBy As String, _
Optional strSeparator = ", ") As Variant
On Error GoTo Err_Handler
'Purpose: Generate a concatenated string of related records.
'Return: String variant, or Null if no matches.
'Arguments: strField = name of field to get results from and concatenate.
' strTable = name of a table or query.
' strWhere = WHERE clause to choose the right values.
' strOrderBy = ORDER BY clause, for sorting the values.
' strSeparator = characters to use between the concatenated values.
'Notes: 1. Use square brackets around field/table names with spaces or odd characters.
' 2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.
' 3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.
' 4. Returning more than 255 characters to a recordset triggers this Access bug:
' http://allenbrowne.com/bug-16.html
Dim rs As DAO.Recordset 'Related records
Dim rsMV As DAO.Recordset 'Multi-valued field recordset
Dim strSql As String 'SQL statement
Dim strOut As String 'Output string to concatenate to.
Dim lngLen As Long 'Length of string.
Dim bIsMultiValue As Boolean 'Flag if strField is a multi-valued field.
'Initialize to Null'
ConcatRelated = Null
'Build SQL string, and get the records.
strSql = "SELECT " & strField & " FROM " & strTable
If strWhere <> vbNullString Then
strSql = strSql & " WHERE " & strWhere
End If
If strOrderBy <> vbNullString Then
strSql = strSql & " ORDER BY " & strOrderBy
End If
Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)
'Determine if the requested field is multi-valued (Type is above 100.)
bIsMultiValue = (rs(0).Type > 100)
'Loop through the matching records
Do While Not rs.EOF
If bIsMultiValue Then
'For multi-valued field, loop through the values
Set rsMV = rs(0).Value
Do While Not rsMV.EOF
If Not IsNull(rsMV(0)) Then
strOut = strOut & rsMV(0) & strSeparator
End If
rsMV.MoveNext
Loop
Set rsMV = Nothing
ElseIf Not IsNull(rs(0)) Then
strOut = strOut & rs(0) & strSeparator
End If
rs.MoveNext
Loop
rs.Close
'Return the string without the trailing separator.
lngLen = Len(strOut) - Len(strSeparator)
If lngLen > 0 Then
ConcatRelated = Left(strOut, lngLen)
End If
Exit_Handler:
'Clean up
Set rsMV = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
Resume Exit_Handler
End Function
I call this function successfully from the following query:
INSERT INTO tblData ( SubjectNumber, RECDATE, RecordedDoses, DoseTimes, FoodType, ProgrammingComments )
SELECT d.SubjectNumber, d.RECDATE, Count(d.RECTIME) AS RecordedDoses, ConcatRelated("RECTIME", "qryDump2", "SubjectNumber= """ & d.[SubjectNumber] & """" & " AND RECDATE=" & FORMAT(d.RECDATE, "\#yyyy-m-d\#")) AS DoseTimes, ConcatRelated("FoodType", "qryDump2", "SubjectNumber= """ & d.[SubjectNumber] & """" & " AND RECDATE=" & FORMAT(d.RECDATE, "\#yyyy-m-d\#")) AS FoodType, d.Visit AS ProgrammingComments
FROM qryDump2 AS d
GROUP BY d.SubjectNumber, d.RECDATE, d.Visit
HAVING Count(d.RECTIME)<2 Or Count(d.RECTIME)>2
ORDER BY d.RECDATE;
The query above references several tables and queries. The issue is, when my criteria is a specific subject, e.g. "1011002", the concatenate function has no problem running. However, when the criteria is anything else, e.g. Prompt criteria, referencing a text box, etc, I get the fun "Error 3061: Too few parameters. Expected 1. If I switch my criteria back to a string, e.g. "1011002" it works again. When using prompt criteria, if I type the same item in, i.e. 1011002, the error appears again.
What am I missing?
Edit: The query that is called a few items down the line that references the criteria I mentioned above is as follows:
SELECT tblDump.SubjectNumber, IIf(tblDump.SD_DAY=1,tblDump.RECDATE,tblDump.RECDATE-1) AS RECDATE, IIf(tblDump.DRUG_Q1=1,tblDump.RECTIME,tblDump.DRUG_Q6) AS RECTIME, tblDump.FoodType, IIf(IIf(tblDump.SD_DAY=1,tblDump.RECDATE,tblDump.RECDATE-1)=tblL.DiscontDate,"DayOfDiscontinuation",IIf(IIf(tblDump.SD_DAY=1,tblDump.RECDATE,tblDump.RECDATE-1)=tblL.CompletionDate,"CompletionDate",IIf(IIf(tblDump.SD_DAY=1,tblDump.RECDATE,tblDump.RECDATE-1)=tblL.[2],"Visit2"))) AS Visit
FROM tblDump LEFT JOIN tblL ON tblDump.SubjectNumber = tblL.SubjectNumber
WHERE tblDump.SubjectNumber=Forms![frm]![test];
The where statement, when I use an actual value, e.g. "1011002" (subject number is text and not a number even though the example I gave is a number), the concatenate function works. When I use what is above, i.e. referencing a form field, I get the aforementioned error.
The where clause isn't checking to see if the text has spaces, maybe trim the form data before putting it into the function call and see if that stops your code from creating an empty where clause in the sql.
Related
I am trying to use this code to calculate median from my query which has these criteria:
<[Form]![testForm2]![crit1] And >[Form]![testForm2]![crit2] and <[Form]![testForm2]![Age1] And >[Form]![testForm2]![Age2]
without these criteria function works well and gives for every task median based on "MP", however when I put in there my criteria I receive error:
error - Too few parameters. Expected 4 and then it says 'Object Variable or With block not set'
my input: DMedian("MP";"testForm2";"[TASK]= '" & [TASK] & "'")
*even when the Form is open it end up with the error.
*I probably need to find a different way to filter this query from the form, but I don't know how
Public Function DMedian(FieldName As String, _
TableName As String, _
Optional Criteria As Variant) As Variant
' Created by Roger J. Carlson
' http://www.rogersaccesslibrary.com
' Terms of use: You may use this function in any application, but
' it must include this notice.
'Returns the median of a given field in a given table.
'Returns -1 if no recordset is created
' You use this function much like the built-in Domain functions
' (DLookUp, DMax, and so on). That is, you must provide the
' 1) field name, 2) table name, and 3) a 'Where' Criteria.
' When used in an aggregate query, you MUST add each field
' in the GROUP BY clause into the into the Where Criteria
' of this function.
' See Help for more on Domain Aggregate functions.
On Error GoTo Err_Median
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim RowCount As Long
Dim LowMedian As Double, HighMedian As Double
'Open a recordset on the table.
Set db = CurrentDb
strSQL = "SELECT " & FieldName & " FROM " & TableName
If Not IsMissing(Criteria) Then
strSQL = strSQL & " WHERE " & Criteria & " ORDER BY " & FieldName
Else
strSQL = strSQL & " ORDER BY " & FieldName
End If
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
'Find the number of rows in the table.
rs.MoveLast
RowCount = rs.RecordCount
rs.MoveFirst
'Determine Even or Odd
If RowCount Mod 2 = 0 Then
'There is an even number of records. Determine the low and high
'values in the middle and average them.
rs.Move Int(RowCount / 2) - 1
LowMedian = rs(FieldName)
rs.Move 1
HighMedian = rs(FieldName)
'Return Median
DMedian = (LowMedian + HighMedian) / 2
Else
'There is an odd number of records. Return the value exactly in
'the middle.
rs.Move Int(RowCount / 2)
'Return Median
DMedian = rs(FieldName)
End If
Exit_Median:
'close recordset
rs.Close
Exit Function
Err_Median:
If Err.number = 3075 Then
DMedian = 0
Resume Exit_Median
ElseIf Err.number = 3021 Then
'EOF or BOF ie no recordset created
DMedian = -1
Resume Exit_Median
Else
MsgBox Err.Description
Resume Exit_Median
End If
End Function
The parameter separation character is comma and you are using a semi-colon
CHANGE:
DMedian("MP";"testForm2";"[TASK]= '" & [TASK] & "'")
TO:
DMedian("MP", "testForm2", "[TASK]= '" & [TASK] & "'")
Solution was to refer the text boxes in SQL declaration, Thank you guys
like this:
HAVING (((Data.[REV]< " & Me.crit1 & ") And (Data.[REV])>" & Me.crit2 & ") AND ((Reg.Age)<" & Me.Age1 & " And (Reg.Age)>" & Me.Age2 & " " & SQLcritComplete & "));"
NOT like this:
"HAVING (((Data.[REV]<[Form]![testForm2]![crit1]) And (Data.[REV])>[testForm2]![crit2]) AND ((Reg.Age)<[Form]![testForm2]![Age1] And (Reg.Age)>[Form]![testForm2]![Age2] & SQLcritComplete & "));"
I am creating a schedule calendar which has been working great, but I want to adjust the SQL so that it only shows when the next job has to be done. I was thinking the best way to achieve this would be via the MAX() function, however when i run the code Access doesn't seem to like it.
Public Sub LoadArray()
'This sub loads an array with the relevant variables from a query
Dim db As Database
Dim rs As Recordset
Dim rsFiltered As Recordset
Dim strQuery As String
Dim i As Integer
Dim Text23 As Integer
On Error GoTo ErrorHandler
Text23 = Forms.frmPreventativeMenu.Form.CompanyName.Value
strQuery = "SELECT tblWMYReports.Company, tblWMYReports.Machine, MAX(tblWMYReports.NextDate), tblWMYReports.WMY " _
& "FROM tblWMYReports " _
& "WHERE (((tblWMYReports.Company)= " & Text23 & " ));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strQuery)
With rs
If Not rs.BOF And Not rs.EOF Then
'Ensures the recordset contains records
For i = 0 To UBound(MyArray)
'Will loop through the array and use dates to filter down the query
'It firsts checks that the second column has true for its visible property
If MyArray(i, 1) = True Then
.Filter = "[NextDate]=" & MyArray(i, 0)
'To filter you must open a secondary recordset and
'Use that as the basis for a query
'This makes sense as you are building a query on a query
Set rsFiltered = .OpenRecordset
If Not rsFiltered.BOF And Not rsFiltered.EOF Then
'If the recordset is not empty then you are able
'to extract the text from the values provided
Do While Not rsFiltered.EOF = True
MyArray(i, 2) = MyArray(i, 2) & vbNewLine & DLookup("MachineName", "tblMachine", "MachineID=" & rsFiltered!Machine)
MyArray(i, 2) = MyArray(i, 2) & " - " & DLookup("WMY", "tblWMY", "ID=" & rsFiltered!WMY)
rsFiltered.MoveNext
Loop
End If
End If
Next i
End If
.Close
End With
ExitSub:
Set db = Nothing
Set rs = Nothing
Exit Sub
ErrorHandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
You are going to aggregate one column with an aggregate function like Sum(), Max(), Count() or similar, then every other column that isn't being aggregated must show up in the SQL's GROUP BY clause:
strQuery = "SELECT tblWMYReports.Company, tblWMYReports.Machine, MAX(tblWMYReports.NextDate), tblWMYReports.WMY " _
& "FROM tblWMYReports " _
& "WHERE (((tblWMYReports.Company)= " & Text23 & " )) " _
& "GROUP BY tblWMYReports.Company, tblWMYReports.Machine, tblWMYReports.WMY;"
I can't guarantee that is going to do what you want it to, since I'm not familiar with your data, code, or application, but it should get you through the error.
You must use a properly formatted string expression for the date value:
.Filter = "[NextDate] = #" & Format(MyArray(i, 0), "yyyy\/mm\/dd") & "#"
I have a table, which was pulled out of some XML data. I'm trying to do a cross reference, so I can line out a plan for organizing the data. This 1 table has a list of variables. Fields of different data types, computations, as well as dialogs. One of the columns has options. If the data type of the variable is a dialog, its options has a list of variables, separated by a semi-colon.
So the main table has a structure like so:
For the dialog records I need to look through their options column and insert records into a normalized table. For each field, in that column, I want to add a record with that dialog name, and the ID of the row in that table (I added a PK to the table). For instance, in the dialog record, Options column, there is a field in there called BusinessName TE. I need to search this main table for the PK ID of the row that has a variable name of the same. I need to put that record's ID with the name of the dialog, and insert both into a new table I set up. This will create a cross reference for me, so I can know which variables are being used by which dialogs.
I appreciate any help anyone can give. I see stuff about using a split function, arrays and looping through to get each value, but the examples I'm finding are for strings, not a column in a table.
Thanks!
Edit: Adding in the VBA code I'm working with. I attached it to a button on a form, just so I could click to run it.
Private Sub RunParse_Click()
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb()
Dim sqlStr, insertSQL, arrayVal As String
Dim TestArray As Variant
Dim Options As String
Dim Dialog As String
Dim FieldName As Long
Dim i As Integer
sqlStr = "SELECT [MASTER Fields].Options,[MASTER Fields].[Variable Name] FROM [MASTER Fields] WHERE ((([MASTER Fields].[Variable Type])='dialog'));"
Set rs = db.OpenRecordset(sqlStr)
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
Options = rs.Fields(0)
Dialog = rs.Fields(1)
If InStr(Options, ";") Then
TestArray = Split(Options, ";")
For i = 0 To UBound(TestArray) - LBound(TestArray) + 1
If TestArray(i) <> "" Then
arrayVal = TestArray(i)
FieldName = DLookup("ID", "MASTER Fields", "[Variable Name] = " & "'" & arrayVal & "'")
insertSQL = "INSERT INTO FieldTemplatesUse(FID, TemplateAK) " _
& "VALUES(""" & FieldName & """, """ & Dialog & """)"
DoCmd.RunSQL (insertSQL)
End If
Next i
End If
rs.MoveNext
Loop
End Sub
right now on the line that says
If TestArray(i) <> "" Then
creates an error ""
If anyone can help, I'd really appreciate it!
Another Edit:
Parfait figured out my issue. I'm posting the final code I am using, in case it helps someone else! p.s. I added a condition to check if the dlookup is successful, and trap failures in a failures table. That way I can check those out afterward.
Private Sub RunParse_Click()
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb()
Dim sqlStr, insertSQL, arrayVal As String
Dim TestArray As Variant
Dim Options As String
Dim Dialog As String
Dim FieldName As Long
Dim i As Integer
sqlStr = "SELECT [Master Fields].Options,[Master Fields].[Variable Name] FROM [Master Fields] WHERE ((([Master Fields].[Variable Type])='dialog'));"
Set rs = db.OpenRecordset(sqlStr)
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
Options = rs.Fields(0)
Dialog = rs.Fields(1)
If InStr(Options, ";") Then
TestArray = Split(Options, ";")
For i = 0 To UBound(TestArray) - LBound(TestArray)
If TestArray(i) <> "" Then
arrayVal = TestArray(i)
If Not (IsNull(DLookup("ID", "Master Fields", "[Variable Name] = " & "'" & arrayVal & "'"))) Then
FieldName = DLookup("ID", "Master Fields", "[Variable Name] = " & "'" & arrayVal & "'")
insertSQL = "INSERT INTO FieldTemplatesUse(FID, TemplateAK) " _
& "VALUES(""" & FieldName & """, """ & Dialog & """)"
DoCmd.RunSQL (insertSQL)
'MsgBox "Adding ID = " & FieldName & "for Dialog: " & Dialog & "Now"
Else
insertSQL = "INSERT INTO tblFieldsNotFound(Dialog, FieldNotFound) " _
& "VALUES(""" & Dialog & """, """ & arrayVal & """)"
DoCmd.RunSQL (insertSQL)
End If
End If
Next i
End If
rs.MoveNext
Loop
MsgBox "All Done!"
End Sub
I have been on the web searching for answers and I just can not find one that works (I'm sure it is something I am not doing right)
I have a table in Access called TBL003_Combined Data that has the following columns:
UPLOADED, REF ID, QTY, PART NUMBER, ITEM DESCRIPTION, SHIP TO
4/8/2015, 123, 20, 9125xtr, sample item, XYZ Company, 789 Address Lane, Somewhere,US 159632
4/8/2015, 123, 16, 22578xtz, sample item2, XYZ Company, 789 Address Lane, Somewhere,US 159632
4/8/2015, 123, 8, 7758rty, sample item3, XYZ Company, 789 Address Lane, Somewhere,US 159632
What I am trying to do is for each unique [REF ID], I want to concatenate the QTY, [PART NUMBER], [ITEM DESCRIPTION] & [SHIP TO] to a new column called [CS_ITEM DESCRIPTION].
I have tried the following in Allen Brown's site:
Public Function ConcatRelated(strField As String, _
strTable As String, _
Optional strWhere As String, _
Optional strOrderBy As String, _
Optional strSeparator = ", ") As Variant
On Error GoTo Err_Handler
'Purpose: Generate a concatenated string of related records.
'Return: String variant, or Null if no matches.
'Arguments: strField = name of field to get results from and concatenate.
' strTable = name of a table or query.
' strWhere = WHERE clause to choose the right values.
' strOrderBy = ORDER BY clause, for sorting the values.
' strSeparator = characters to use between the concatenated values.
'Notes: 1. Use square brackets around field/table names with spaces or odd characters.
' 2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.
' 3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.
' 4. Returning more than 255 characters to a recordset triggers this Access bug:
' http://allenbrowne.com/bug-16.html
Dim rs As DAO.Recordset 'Related records
Dim rsMV As DAO.Recordset 'Multi-valued field recordset
Dim strSQL As String 'SQL statement
Dim strOut As String 'Output string to concatenate to.
Dim lngLen As Long 'Length of string.
Dim bIsMultiValue As Boolean 'Flag if strField is a multi-valued field.
'Initialize to Null
ConcatRelated = Null
'Build SQL string, and get the records.
strSQL = "SELECT DISTINCT " & strField & " FROM " & strTable
If strWhere <> vbNullString Then
strSQL = strSQL & " WHERE " & strWhere
End If
If strOrderBy <> vbNullString Then
strSQL = strSQL & " ORDER BY " & strOrderBy
End If
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenDynaset)
'Determine if the requested field is multi-valued (Type is above 100.)
bIsMultiValue = (rs(0).Type > 100)
'Loop through the matching records
Do While Not rs.EOF
If bIsMultiValue Then
'For multi-valued field, loop through the values
Set rsMV = rs(0).Value
Do While Not rsMV.EOF
If Not IsNull(rsMV(0)) Then
strOut = strOut & rsMV(0) & strSeparator
End If
rsMV.MoveNext
Loop
Set rsMV = Nothing
ElseIf Not IsNull(rs(0)) Then
strOut = strOut & rs(0) & strSeparator
End If
rs.MoveNext
Loop
rs.Close
'Return the string without the trailing separator.
lngLen = Len(strOut) - Len(strSeparator)
If lngLen > 0 Then
ConcatRelated = Left(strOut, lngLen)
End If
Exit_Handler:
'Clean up
Set rsMV = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
Resume Exit_Handler
End Function
and my query I've used the following:
SELECT DISTINCT
[REF ID],
ConcatRelated("[QTY],[PART NUMBER], [ITEM DESCRIPTION], [SHIP TO]",
"[TBL003_Combined Data]",
"[REF ID] = " & [REF ID],
"("[QTY],[PART NUMBER], [ITEM DESCRIPTION], [SHIP TO]",
"/"
) AS CS_ITEM DESCRIPTIONS
FROM [TBL003_Combined Data];
and I keep getting the following error:
"Syntax error (missing operator) in query expression...."
then it list the entire SQL I'm referencing above (Select Distinct). Any help in pointing me in the right direction or advising why I am doing wrong (as I'm certain it's me) will be greatly appreciated.
added: The result I'm trying to reach is for the data to come out as follows:
UPLOADED, REF ID, CS_ITEM DESCRIPTION
4/8/2015, 123, 20 / 9125xtr / sample item / 16 / 22578xtz /sample item2 / 8 / 7758rty / sample item3 / XYZ Company, 789 Address Lane, Somewhere,US 159632
Try this:
SELECT distinct [REF ID],
[QTY] + ' ' + [PART NUMBER] + ' ' + [ITEM DESCRIPTION] + ' ' + [SHIP TO]
AS 'CS_ITEM DESCRIPTIONS'
FROM [TBL003_Combined Data];
Abstract:
I'm using VB to recreate a query each time a user selects one of 3 options from a drop down menu, which appends the WHERE clause If they've selected anything from the combo boxes. I then am attempting to get the information displayed on the form to refresh thereby filtering what is displayed in the table based on user input.
1) Dynamically created query using VB.
Private Sub BuildQuery()
' This sub routine will redefine the subQryAllJobsQuery based on input from
' the user on the Management tab.
Dim strQryName As String
Dim strSql As String ' Main SQL SELECT statement
Dim strWhere As String ' Optional WHERE clause
Dim qryDef As DAO.QueryDef
Dim dbs As DAO.Database
strQryName = "qryAllOpenJobs"
strSql = "SELECT * FROM tblOpenJobs"
Set dbs = CurrentDb
' In case the query already exists we should deleted it
' so that we can rebuild it. The ObjectExists() function
' calls a public function in GlobalVariables module.
If ObjectExists("Query", strQryName) Then
DoCmd.DeleteObject acQuery, strQryName
End If
' Check to see if anything was selected from the Shift
' Drop down menu. If so, begin the where clause.
If Not IsNull(Me.cboShift.Value) Then
strWhere = "WHERE tblOpenJobs.[Shift] = '" & Me.cboShift.Value & "'"
End If
' Check to see if anything was selected from the Department
' drop down menu. If so, append or begin the where clause.
If Not IsNull(Me.cboDepartment.Value) Then
If IsNull(strWhere) Then
strWhere = strWhere & " AND tblOpenJobs.[Department] = '" & Me.cboDepartment.Value & "'"
Else
strWhere = "WHERE tblOpenJobs.[Department] = '" & Me.cboDepartment.Value & "'"
End If
End If
' Check to see if anything was selected from the Date
' field. If so, append or begin the Where clause.
If Not IsNull(Me.txtDate.Value) Then
If Not IsNull(strWhere) Then
strWhere = strWhere & " AND tblOpenJobs.[Date] = '" & Me.txtDate.Value & "'"
Else
strWhere = "WHERE tblOpenJobs.[Date] = '" & Me.txtDate.Value & "'"
End If
End If
' Concatenate the Select and the Where clause together
' unless all three parameters are null, in which case return
' just the plain select statement.
If IsNull(Me.cboShift.Value) And IsNull(Me.cboDepartment.Value) And IsNull(Me.txtDate.Value) Then
Set qryDef = dbs.CreateQueryDef(strQryName, strSql)
Else
strSql = strSql & " " & strWhere
Set qryDef = dbs.CreateQueryDef(strQryName, strSql)
End If
End Sub
2) Main Form where the user selects items from combo boxes.
picture of the main form and sub form
http://i48.tinypic.com/25pjw2a.png
3) Subform pointed at the query created in step 1.
Chain of events:
1) User selects item from drop down list on the main form.
2) Old query is deleted, new query is generated (same name).
3) Subform pointed at query does not update, but if you open the query by itself the correct results are displayed.
Name of the Query: qryAllOpenJobs
name of the subform: subQryAllOpenJobs
Also, the Row Source of subQryAllOpenJobs = qryAllOpenJobs
Name of the main form: frmManagement
I think you have your logic on the Department drop down check backwards.
You have it checking if strWhere is null, then if it is, you concatenate strWhere with the value of cboDepartment.
You should be doing what you are for Date.
' Check to see if anything was selected from the Department
' drop down menu. If so, append or begin the where clause.
If Not IsNull(Me.cboDepartment.Value) Then
If Not IsNull(strWhere) Then
strWhere = strWhere & " AND tblOpenJobs.[Department] = '" & Me.cboDepartment.Value & "'"
Else
strWhere = "WHERE tblOpenJobs.[Department] = '" & Me.cboDepartment.Value & "'"
End If
End If
You may also want to do:
If Nz(strWhere,"") = "" then
Instead of just doing IsNull so that you catch the zero-length string in addition to a null variable.
As for setting the recordsource, use something along the lines of
Me.sfrmJobs.Form.RecordSource = strSQL
where sfrmJobs is the name of your subform.
An empty string is not the same thing as Null. When you declare a String variable such as this:
Dim strWhere As String
strWhere is initialized as an empty string (or "zero length string"). That value is sometimes referred to as a null string, and there is even a VBA constant, vbNullString, which represents the empty string. However, regardless of which name you use, the empty string variable is not Null. Furthermore a VBA String variable can never be Null. For example, this code will cause error 94, 'Invalid use of Null':
Dim strWhere As String
strWhere = Null
The reason I am emphasizing this point is because your code tests whether strWhere is Null. That is a logic flaw because strWhere will never be Null. For example, I don't believe this condition can ever be True:
If IsNull(strWhere) Then
If you want a test to determine when strWhere has not had a value assigned to it (it's still an empty string), use the Len function:
If Len(strWhere) = 0 Then
Here is a different approach for BuildQuery. It assumes the data type for your [Date] field is String (as your original code suggests). If [Date] is actually Date/Time data type, this code will not work. Also, please note that Date is a reserved word (see Problem names and reserved words in Access). I enclosed the field name in square brackets to avoid ambiguity. If it were my own database, I would change the field name instead.
Private Sub BuildQuery()
'* Update subform RecordSource based on input from *'
'* the user on the Management tab. *'
Dim strSql As String ' Main SQL SELECT statement '
Dim strWhere As String ' Optional WHERE clause '
Dim i As Integer
Dim strControl As String
Dim strField As String
strSql = "SELECT * FROM tblOpenJobs AS oj"
strWhere = vbNullString
For i = 1 To 3
Select Case i
Case 1
strControl = "cboShift"
strField = "Shift"
Case 2
strControl = "cboDepartment"
strField = "Department"
Case 3
strControl = "txtDate"
strField = "[Date]"
End Select
If Not IsNull(Me.Controls(strControl).Value) Then
strWhere = strWhere & _
IIf(Len(strWhere) > 0, " AND ", "") & _
"oj." & strField & " = '" & _
Me.Controls(strControl).Value & "'"
End If
Next i
If Len(strWhere) > 0 Then
strSql = strSql & " WHERE " & strWhere
End If
'* use the name of the subform CONTROL for sfrmJobs *'
'* (may not be the name of the subform) *'
Me.sfrmJobs.Form.RecordSource = strSql
End Sub
My solution is below in three parts. (1) Build Query, (2) Main Form, (3) Subform.
`Private Sub OpenJobsQuery()
' This sub will construct the query on the front page for the user
' based on who they are and what they select from the combo boxes above
' the table for filtering by redefining the rowsource of the subform
' subQryOpenJobs
Dim strSql As String ' Main SQL SELECT statement
Dim strWhere As String ' Where clause containing user specified parameters.
strSql = "SELECT * FROM tblOpenJobs"
strWhere = ""
' Check to see if anything was selected from the Shift
' combo box. If so, begin the Where clause.
If Not IsNull(Me.cboOpenJobShift.Value) Then
strWhere = "WHERE tblOpenJobs.[Shift] = '" & Me.cboOpenJobShift.Value & "'"
End If
' Check to see if anything was selected from the Department
' combo box. If so, append or begin the where clause.
If Not IsNull(Me.cboOpenJobDepartment.Value) Then
If strWhere = "" Then
strWhere = "WHERE tblOpenJobs.[Department] = '" & Me.cboOpenJobDepartment.Value & "'"
Else
strWhere = strWhere & " AND tblOpenJobs.[Department] = '" & Me.cboOpenJobDepartment.Value & "'"
End If
End If
' Check to see if anything was selected from the Date
' field. If so, append or begin the Where clause.
If Not IsNull(Me.cboOpenJobDate.Value) Then
If strWhere = "" Then
strWhere = "WHERE tblOpenJobs.[JobDate] = #" & Me.cboOpenJobDate.Value & "#"
Else
strWhere = strWhere & " AND tblOpenJobs.[JobDate] = #" & Me.cboOpenJobDate.Value & "#"
End If
Else
' If nothing was entered in the date field, make sure the user
' only sees future jobs.
If strWhere = "" Then
strWhere = "WHERE tblOpenJobs.[JobDate] > #" & FormatDateTime(Date, vbShortDate) & "#"
Else
strWhere = strWhere & " AND tblOpenJobs.[JobDate] > #" & FormatDateTime(Date, vbShortDate) & "#"
End If
End If
' Always include as part of the where clause, a section that
' will narrow the results based on who the user is
If strWhere = "" Then
strWhere = "WHERE tblOpenJobs.[OpenJobID] Not In " & _
"(SELECT tblSignUps.[OpenJobID] FROM tblSignUps WHERE tblSignUps.[EUID] = '" & strEUID & "');"
Else
strWhere = strWhere & " AND tblOpenJobs.[OpenJobID] Not In " & _
"(SELECT tblSignUps.[OpenJobID] FROM tblSignUps WHERE tblSignUps.[EUID] = '" & strEUID & "');"
End If
' Concatenate the Select and the Where clause together
strSql = strSql & " " & strWhere
' Set the recordsource of the subform to the SQL query generated
' and refresh the form.
Me.subQryOpenJobs.Form.RecordSource = strSql
' In addition, synchronize the JobID's in the Edit Job box to match those
' filtered by this Build Query.
Me.cboSelectJOBID.RowSource = "SELECT tblOpenJobs.[OpenJobID] FROM tblOpenJobs" & " " & strWhere
Me.Refresh
End Sub`
(2) Main Form. http://j.imagehost.org/view/0385/Form. and (3) the subform is populated as shown in the BuildQuery() sub to construct the query based on what the user selects from the drop down filters and the input boxes on the right of the form. The data in the table itself is inaccessible to the user, this is just for them to reference.