VBA Help for Adhoc Field To Be shown in Query

Trevor G

Trevor G

Registered User.
Local time
Today, 11:17
Joined
Oct 1, 2009
Messages
2,368
I am in the process of creating a form which will use a listbox and have multiple check boxes, what I am aiming for is select multiple years form the listbox, then use some or all of the checkboxes to build a query, if the check box is checked the field is to be included in the query, if not then ignore it.

So far I have created the form add the list box and checkboxes named each item, added the code to reset and also created the code to run the query, I am stuck on the check box part.

Here is my code so far, I have named each checkbox with a prefix of CHK and also set a tag called CHK in there properties. I have created the Dim strParam and this is where I am stuck, the query currently will open all the fields in the table.

The form name is "frmCreateCriteria" and I have attached a copy of the testing database.

Private Sub cmdShowResults_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strSQL As String
Dim strParam As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryAdhocSearch")
For Each varItem In Me!lstUWYear.ItemsSelected
strCriteria = strCriteria & "," & Me!lstUWYear.ItemData(varItem) & ""
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list", vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
strSQL = "SELECT * FROM Combined " & _
"WHERE [Combined].[Underwriting Year] IN(" & strCriteria & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "qryAdhocSearch"
Set db = Nothing
Set qdf = Nothing
End Sub
 

Attachments

Trevor G said:
I am in the process of creating a form which will use a listbox and have multiple check boxes, what I am aiming for is select multiple years form the listbox, then use some or all of the checkboxes to build a query, if the check box is checked the field is to be included in the query, if not then ignore it.

So far I have created the form add the list box and checkboxes named each item, added the code to reset and also created the code to run the query, I am stuck on the check box part.

Here is my code so far, I have named each checkbox with a prefix of CHK and also set a tag called CHK in there properties. I have created the Dim strParam and this is where I am stuck, the query currently will open all the fields in the table.

The form name is "frmCreateCriteria" and I have attached a copy of the testing database.

Private Sub cmdShowResults_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strSQL As String
Dim strParam As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryAdhocSearch")
For Each varItem In Me!lstUWYear.ItemsSelected
strCriteria = strCriteria & "," & Me!lstUWYear.ItemData(varItem) & ""
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list", vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
strSQL = "SELECT * FROM Combined " & _
"WHERE [Combined].[Underwriting Year] IN(" & strCriteria & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "qryAdhocSearch"
Set db = Nothing
Set qdf = Nothing
End Sub
Click to expand...

Note: I am not at a computer where it is safe to look at attachments.

The reason you are getting all the field is because you are selecting all the field by using:

strSQL = "SELECT * FROM Combined " & _
"WHERE [Combined].[Underwriting Year] IN(" & strCriteria & ");"

In the SELECT * FROM part, the * means all fields. You will need to change this to only include the fields you need.

Maybe something like:

Code: 
strSQL = ""

If checkBox1 then

   if strSQL = "" then  

        strSQL = "SELECT  Field1"
    else

         strSQL = strSQL & ", Field1"
    End if
End if

If checkBox2 then

   if strSQL = "" then  

        strSQL = "SELECT  Field2"
    else

         strSQL = strSQL & ", Field2"
    End if
End if

' repeat for each check box or change to loop though the controls


strSQL = strSQL & "FROM Combined WHERE [Combined].[Underwriting Year] IN(" & strCriteria & ");"
 
Thank you I have now been able to use the check box's no problems but I don't see the list box options, even though they are part of the criteria?

Any pointers would be greatly appreciated, the underwriting year is a numeric field and it is populated in the list box.

The code complete is shown below:

Private Sub cmdSample1_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strSQL As String
Dim strParam As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryAdhocSearch")
For Each varItem In Me!lstUWYear.ItemsSelected
strCriteria = strCriteria & "," & Me!lstUWYear.ItemData(varItem) & ""
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list", vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
strSQL = ""
If Me.chkBroker Then
If strSQL = "" Then
strSQL = "SELECT BROKER"
Else
strSQL = strSQL & ", BROKER"
End If
End If
If Me.chkBUG Then
If strSQL = "" Then
strSQL = "SELECT BUG"
Else
strSQL = strSQL & ", BUG"
End If
End If
If Me.chkExcess Then
If strSQL = "" Then
strSQL = "SELECT Excess"
Else
strSQL = strSQL & ", Excess"
End If
End If
If Me.chkExcessGBP Then
If strSQL = "" Then
strSQL = "SELECT [Excess GBP]"
Else
strSQL = strSQL & ", [Excess GBP]"
End If
End If
If Me.chkInsuredName Then
If strSQL = "" Then
strSQL = "SELECT [INSURED NAME]"
Else
strSQL = strSQL & ", [INSURED NAME]"
End If
End If
If Me.chkLimit Then
If strSQL = "" Then
strSQL = "SELECT limit"
Else
strSQL = strSQL & ", limit"
End If
End If
If Me.chkLimitCCY Then
If strSQL = "" Then
strSQL = "SELECT [LIMIT CCY]"
Else
strSQL = strSQL & ", [LIMIT CCY]"
End If
End If
If Me.chkLimitGBP Then
If strSQL = "" Then
strSQL = "SELECT [LIMIT GBP]"
Else
strSQL = strSQL & ", [LIMIT GBP]"
End If
End If
If Me.chkLocation1 Then
If strSQL = "" Then
strSQL = "SELECT LOCATION1"
Else
strSQL = strSQL & ", LOCATION1"
End If
End If
If Me.chkTechUWTeam Then
If strSQL = "" Then
strSQL = "SELECT [TechUWTeam Desc]"
Else
strSQL = strSQL & ", [TechUWTeam Desc]"
End If
End If


' repeat for each check bos or change to loop though the controls
strSQL = strSQL & " FROM Combined "
strSQL = strSQL & "WHERE [Combined].[Underwriting Year] IN(" & strCriteria & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "qryAdhocSearch"
Set db = Nothing
Set qdf = Nothing
End Sub
 
Please use code tags when posting code here (especially long sets of it) so it is formatte easier to read.

codetag001.png
 
Thank you Bob for the reminder I will do this.
 
Trevor G said:
Thank you I have now been able to use the check box's no problems but I don't see the list box options, even though they are part of the criteria?

Any pointers would be greatly appreciated, the underwriting year is a numeric field and it is populated in the list box.

The code complete is shown below:

Private Sub cmdSample1_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strSQL As String
Dim strParam As String

Set db = CurrentDb()
Set qdf = db.QueryDefs("qryAdhocSearch")
For Each varItem In Me!lstUWYear.ItemsSelected
strCriteria = strCriteria & "," & Me!lstUWYear.ItemData(varItem) & ""
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list", vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
strSQL = ""
If Me.chkBroker Then
If strSQL = "" Then
strSQL = "SELECT BROKER"
Else
strSQL = strSQL & ", BROKER"
End If
End If
If Me.chkBUG Then
If strSQL = "" Then
strSQL = "SELECT BUG"
Else
strSQL = strSQL & ", BUG"
End If
End If
If Me.chkExcess Then
If strSQL = "" Then
strSQL = "SELECT Excess"
Else
strSQL = strSQL & ", Excess"
End If
End If
If Me.chkExcessGBP Then
If strSQL = "" Then
strSQL = "SELECT [Excess GBP]"
Else
strSQL = strSQL & ", [Excess GBP]"
End If
End If
If Me.chkInsuredName Then
If strSQL = "" Then
strSQL = "SELECT [INSURED NAME]"
Else
strSQL = strSQL & ", [INSURED NAME]"
End If
End If
If Me.chkLimit Then
If strSQL = "" Then
strSQL = "SELECT limit"
Else
strSQL = strSQL & ", limit"
End If
End If
If Me.chkLimitCCY Then
If strSQL = "" Then
strSQL = "SELECT [LIMIT CCY]"
Else
strSQL = strSQL & ", [LIMIT CCY]"
End If
End If
If Me.chkLimitGBP Then
If strSQL = "" Then
strSQL = "SELECT [LIMIT GBP]"
Else
strSQL = strSQL & ", [LIMIT GBP]"
End If
End If
If Me.chkLocation1 Then
If strSQL = "" Then
strSQL = "SELECT LOCATION1"
Else
strSQL = strSQL & ", LOCATION1"
End If
End If
If Me.chkTechUWTeam Then
If strSQL = "" Then
strSQL = "SELECT [TechUWTeam Desc]"
Else
strSQL = strSQL & ", [TechUWTeam Desc]"
End If
End If


' repeat for each check bos or change to loop though the controls
strSQL = strSQL & " FROM Combined "
strSQL = strSQL & "WHERE [Combined].[Underwriting Year] IN(" & strCriteria & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "qryAdhocSearch"
Set db = Nothing
Set qdf = Nothing
End Sub
Click to expand...



After this code runs:

Code: 
   For Each varItem In Me!lstUWYear.ItemsSelected
      strCriteria = strCriteria & "," & Me!lstUWYear.ItemData(varItem) & ""
   Next varItem

What is the value in strCriteria?


The code looks like it is placing a , before the first value. If it does, this is a problem. In the code for the check boxes, I was testing for this. You will need to modify this code to work so that the first item added does not get a , placed before it.

TIP: try opeing the query qryAdhocSearch in the query designer to see if it gets errors when opening in design mode.
 
It does add the year in the query window, but keeps it invisible, if I check the show it previews with the year, but of course I don't want users to do.

The code here is looking at the list box which shows the year, the year is a numeric number field, I don't know if that has an impact

For Each varItem In Me!lstUWYear.ItemsSelected
strCriteria = strCriteria & "," & Me!lstUWYear.ItemData(varItem) & ""
Next varItem
 
You must log in or register to reply here.

Similar threads

C
Solved Position form to added record
Replies
8
Views
491
ClaraBarton
C
R
VBA not working for saved query parameters
2
Replies
24
Views
776
RonPaii
RonPaii
N
How to ensure that the current stock control is update when the data appears on the subform in access
Replies
5
Views
842
Minty
Minty
N
How to send filtered transactions in the MS Access Combo box with one Click
Replies
15
Views
907
Mark_
M
N
Solved How get lid of domain function and replace them with opening recordset in MS Access VBA
Replies
10
Views
510
nector
N

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom