How to turn Code Into Function

D

DOYLE60

The code below is on the click of a command button. But I now need to make it
a module. How do I turn it into a module? And to run it from a macro, do I
use the RunCode option? Thanks.

The code below, by the way, populates a query with the choices made in a list
box on a form. The form name is "RFDialogPrintfrm". I believe this will have
to be substituted for the "Me!" below and maybe some other things. I attempted
to change it into a module but totally failed. Thanks.

Matt
__________________________________________

Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [ClassOfTradetbl]"
Else
Q.SQL = "Select * From [ClassOfTradetbl] Where [ClassOfTrade] In(" & Criteria &
");"
End If

End Sub
__________________________________
 
K

Ken Snell [MVP]

If you want to run this from a macro, then you'll need to turn it into a
Public Function. However, if you want to run it from a command button via
VBA code, then it can be either a function or a subroutine. Are you sure you
need to run it from a macro?

If you run it from VBA code, you can pass the listbox object as an argument
to the new procedure and then it will be more generic.

Assuming that you know how to create a new module (remember, it cannot be
named the same as any procedures that are in the module), create a module
and then paste the following code in the module (this assumes that you're
passing the listbox argument):

Public Function CreateQueryFromListbox(ByRef lstBox As Control)

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = lstBox
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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [ClassOfTradetbl]"
Else
Q.SQL = "Select * From [ClassOfTradetbl] Where [ClassOfTrade] In(" &
Criteria &
");"
End If

Set ctl = Nothing

End Function



Then you'd call it from your command button's Click event this way:

Private Sub Command32_Click()
Dim varDummy As Variant
varDummy = CreateQueryFromListbox(Me![ClassOfTradeChosen])
End Sub
 
D

DOYLE60

Thanks for your answer. But I really need to run this with a macro only. You
see, I have more than ten reports on this one dialog form. The user clicks the
report he wants and the macro (with Conditions) is used to pick the report to
open. So I wish this code to head a macro list that I already have.

When the user hits the Print command button, this code has to fire off.

So all the code needs to be in the module. Thanks,

Matt



If you want to run this from a macro, then you'll need to turn it into a
Public Function. However, if you want to run it from a command button via
VBA code, then it can be either a function or a subroutine. Are you sure you
need to run it from a macro?

If you run it from VBA code, you can pass the listbox object as an argument
to the new procedure and then it will be more generic.

Assuming that you know how to create a new module (remember, it cannot be
named the same as any procedures that are in the module), create a module
and then paste the following code in the module (this assumes that you're
passing the listbox argument):

Public Function CreateQueryFromListbox(ByRef lstBox As Control)

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = lstBox
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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [ClassOfTradetbl]"
Else
Q.SQL = "Select * From [ClassOfTradetbl] Where [ClassOfTrade] In(" &
Criteria &
");"
End If

Set ctl = Nothing

End Function



Then you'd call it from your command button's Click event this way:

Private Sub Command32_Click()
Dim varDummy As Variant
varDummy = CreateQueryFromListbox(Me![ClassOfTradeChosen])
End Sub
--

Ken Snell
<MS ACCESS MVP>







DOYLE60 said:
The code below is on the click of a command button. But I now need to
make it
a module. How do I turn it into a module? And to run it from a macro, do
I
use the RunCode option? Thanks.

The code below, by the way, populates a query with the choices made in a
list
box on a form. The form name is "RFDialogPrintfrm". I believe this will
have
to be substituted for the "Me!" below and maybe some other things. I
attempted
to change it into a module but totally failed. Thanks.

Matt
__________________________________________

Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [ClassOfTradetbl]"
Else
Q.SQL = "Select * From [ClassOfTradetbl] Where [ClassOfTrade] In(" &
Criteria &
");"
End If

End Sub
__________________________________
 
D

DOYLE60

I think I partly figured out my problem. If I use the DoCmd.RunMacro at the
end of the code I already have, I can simply change the Command I already have
into the Print Preview Button. So I can simply put this at the end of the
code: 'DoCmd.RunMacro "RFDialogPrintfrmMacros.PreviewReports".

My only problem is that I really have two, no one, list box to filter. But I
don't know how to combine the two codes on two different command buttons below
into one code. I tried a few weeks again but failed. So how do I combine the
two codes below? After that, I think I can do it myself. Thanks.

Matt

First code:
_________________________________

Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [ClassOfTradetbl]"
Else
Q.SQL = "Select * From [ClassOfTradetbl] Where [ClassOfTrade] In(" & Criteria &
");"
End If

End Sub
________________________

Second code:
________________________

Private Sub Command33_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [Planttbl]"
Else
Q.SQL = "Select * From [Planttbl] Where [Plnt] In(" & Criteria & ");"
End If

End Sub
_____________________

Matt
 
K

Ken Snell [MVP]

Assuming that the query will use AND logic (both criteria must be met):

(air code -- test and modify as needed)



Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In(" & Criteria & ")"
End If


Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" Where [Plnt] In(" & Criteria & ")"
End If

Set ctl = Nothing

End Sub



--

Ken Snell
<MS ACCESS MVP>


DOYLE60 said:
I think I partly figured out my problem. If I use the DoCmd.RunMacro at
the
end of the code I already have, I can simply change the Command I already
have
into the Print Preview Button. So I can simply put this at the end of the
code: 'DoCmd.RunMacro "RFDialogPrintfrmMacros.PreviewReports".

My only problem is that I really have two, no one, list box to filter. But
I
don't know how to combine the two codes on two different command buttons
below
into one code. I tried a few weeks again but failed. So how do I combine
the
two codes below? After that, I think I can do it myself. Thanks.

Matt

First code:
_________________________________

Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [ClassOfTradetbl]"
Else
Q.SQL = "Select * From [ClassOfTradetbl] Where [ClassOfTrade] In(" &
Criteria &
");"
End If

End Sub
________________________

Second code:
________________________

Private Sub Command33_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [Planttbl]"
Else
Q.SQL = "Select * From [Planttbl] Where [Plnt] In(" & Criteria & ");"
End If

End Sub
_____________________

Matt
 
D

DOYLE60

Thanks Ken. But this line in your code got an error:

Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" Where [Plnt] In(" & Criteria & ")"

I tried tweaking it but don't know what I'm doing. Your original code is
below.

Thanks,

Matt

__________________________________________

Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In(" & Criteria & ")"
End If


Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" Where [Plnt] In(" & Criteria & ")"
End If

Set ctl = Nothing

End Sub
 
K

Ken Snell [MVP]

Sorry - I forgot to "blank" out the Criteria variable between the two loops:


Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In(" & Criteria & ")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" Where [Plnt] In(" & Criteria & ")"
End If

Set ctl = Nothing

End Sub
 
D

DOYLE60

Thanks Ken,

Somehow I missed your answer. I will try this code later. If you do not hear
from me about this matter again, it worked and thanks all the more.

Matt
 
D

DOYLE60

Hi Ken,
Sorry to say, I'm still getting an error on this line:

Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" Where [Plnt] In(" & Criteria & ")"

The error says "Character found at the end of SQL Statement."

To remind you, we are trying to get two codes to run as one, and the only thing
you changed in the last code was the adding of the:

Criteria = ""

line. Version 2 of your code is below.

Thanks,

Matt

______________________________


Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In(" & Criteria & ")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" Where [Plnt] In(" & Criteria & ")"
End If

Set ctl = Nothing

End Sub
 
K

Ken Snell [MVP]

I think I see one more typo that I left in. Try the code below:

-----------------------------------------------------
Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In (" & Criteria & ")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" [Plnt] In (" & Criteria & ")"
End If

Set ctl = Nothing

End Sub
----------------------------------------------------

If this still isn't successful, then use the following code, as it'll write
the two Criteria strings to the Immediate window so that you can copy them
and paste them into a message (that'll help us see what might be wrong):

-----------------------------------------------------
Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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


Debug.Print "1st: " & Criteria

Set db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In (" & Criteria & ")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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

Debug.Print "2nd: " & Criteria

Set db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" [Plnt] In (" & Criteria & ")"
End If


Set ctl = Nothing

End Sub
----------------------------------------------------

--

Ken Snell
<MS ACCESS MVP>


DOYLE60 said:
Hi Ken,
Sorry to say, I'm still getting an error on this line:

Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" Where [Plnt] In(" & Criteria & ")"

The error says "Character found at the end of SQL Statement."

To remind you, we are trying to get two codes to run as one, and the only
thing
you changed in the last code was the adding of the:

Criteria = ""

line. Version 2 of your code is below.

Thanks,

Matt
 
D

DOYLE60

Ken,
It didn't work again. I never thought it would be so hard to get two working
codes to just run one after the other.

The error yellows out the whole line below:

Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" [Plnt] In (" & Criteria & ")"

But has the little arrow point only to the bottom portion (if that is just
standard or if it means the errors actually on the second line, I don't know).

The error message is the same: "Character found at the end of SQL Statement."

I put in the second code you gave me to see what happens in the debug window.
When nothing is chosen in the List boxes, it works, no error, and the queiries
are full as they should be. The debug gives me:

1st:
2nd:

When I choose something in the first list box and nothing in the second, it
gives this:

1st: "ZCHM","ZCMP"
2nd:

and the queries work and no error.

When I choose something in the second list box (where it gives an error), the
debug gives this:

1st: "ZCHM","ZCMP"
2nd: "0100","0200"

and gives me the error. The query doesn't change, however, to the ones listed;
it remains the same as whatever it was before.

Do you want to try again? Do you want me to build a small database for you
with this problem? Or should we just turn them into separate functions that I
can call up in a macro?

Sorry to give you such a doozy of a problem.

Thanks for your kind attention in seeing this through,

Matt

Your last is below (not the debug):
___________________________________________

Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In (" & Criteria & ")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" [Plnt] In (" & Criteria & ")"
End If

Set ctl = Nothing

End Sub
 
T

Tim Ferguson

(e-mail address removed) (DOYLE60) wrote in
The error message is the same: "Character found at the end of SQL
Statement."

is there a semicolon in the string Criteria?

Tim F
 
M

Marshall Barton

DOYLE60 said:
Ken,
It didn't work again. I never thought it would be so hard to get two working
codes to just run one after the other.

The error yellows out the whole line below:

Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" [Plnt] In (" & Criteria & ")"


I think you need a Where in there:

Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, " WHERE",
" And") & _
 
K

Ken Snell [MVP]

OK, what you've now posted points me to the problem. The code was not
inserting a WHERE word when the first criterion was not being used. Try
this:


Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In (" & Criteria & ")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, " WHERE", " And") & _
" [Plnt] In (" & Criteria & ")"
End If

Set ctl = Nothing

End Sub


--

Ken Snell
<MS ACCESS MVP>


DOYLE60 said:
Ken,
It didn't work again. I never thought it would be so hard to get two
working
codes to just run one after the other.

The error yellows out the whole line below:

Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" [Plnt] In (" & Criteria & ")"

But has the little arrow point only to the bottom portion (if that is just
standard or if it means the errors actually on the second line, I don't
know).

The error message is the same: "Character found at the end of SQL
Statement."

I put in the second code you gave me to see what happens in the debug
window.
When nothing is chosen in the List boxes, it works, no error, and the
queiries
are full as they should be. The debug gives me:

1st:
2nd:

When I choose something in the first list box and nothing in the second,
it
gives this:

1st: "ZCHM","ZCMP"
2nd:

and the queries work and no error.

When I choose something in the second list box (where it gives an error),
the
debug gives this:

1st: "ZCHM","ZCMP"
2nd: "0100","0200"

and gives me the error. The query doesn't change, however, to the ones
listed;
it remains the same as whatever it was before.

Do you want to try again? Do you want me to build a small database for
you
with this problem? Or should we just turn them into separate functions
that I
can call up in a macro?

Sorry to give you such a doozy of a problem.

Thanks for your kind attention in seeing this through,

Matt

Your last is below (not the debug):
___________________________________________

Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In (" & Criteria &
")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, "", " And") & _
" [Plnt] In (" & Criteria & ")"
End If

Set ctl = Nothing

End Sub
 
D

DOYLE60

Ken,
It still doesn't work. In some earlier code, you had a "where" in a different
spot. I tried the earlier code with some of your other changes, I tried mixing
your new WHERE with the old WHERE, and tried some other things, and still no
go.

By the way, even when nothing is chosen in both list boxes, the code does not
work for the second list box. It doesn't give me an error but it also doesn't
fill the queries as it should.

Just wondering, should the second half use "ct2" instead of "ct1" throughout?

Should we try the two function method?

Thanks again,

Matt


Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In (" & Criteria & ")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, " WHERE", " And") & _
" [Plnt] In (" & Criteria & ")"
End If

Set ctl = Nothing

End Sub
 
D

DOYLE60

There is no semi in the data, if that is what you mean. There were periods and
colons in a related field that the query returned, but not THE field. But I
took them out and the code still failed.

Thanks for your attention in this matter,

Matt
 
K

Ken Snell [MVP]

< slap to my head >

Duh.... I have just now realized that my copy/paste perpetuated another
error on my part. I forgot to remove the second set of "Set Q =" lines. So
we kept redefining the variable Q halfway through, thereby losing what was
being built.

Try this:

Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In (" & Criteria & ")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, " WHERE", " And") & _
" [Plnt] In (" & Criteria & ")"
End If

Set ctl = Nothing

End Sub

--

Ken Snell
<MS ACCESS MVP>


DOYLE60 said:
Ken,
It still doesn't work. In some earlier code, you had a "where" in a
different
spot. I tried the earlier code with some of your other changes, I tried
mixing
your new WHERE with the old WHERE, and tried some other things, and still
no
go.

By the way, even when nothing is chosen in both list boxes, the code does
not
work for the second list box. It doesn't give me an error but it also
doesn't
fill the queries as it should.

Just wondering, should the second half use "ct2" instead of "ct1"
throughout?

Should we try the two function method?

Thanks again,

Matt


Private Sub Command32_Click()

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In (" & Criteria &
")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, " WHERE", " And") & _
" [Plnt] In (" & Criteria & ")"
End If

Set ctl = Nothing

End Sub
 
D

DOYLE60

Ken,
No error. But nor does it work.

When nothing is chosen in the bottom one the top one works. (I check if it
works by going to the query.)

When somehting is chosen in the bottom one, howeer, the top one (when opening
the query) asks for a parameter that belongs to the bottom one. That is, it
asks for "Plnt," which has nothing to do with that query.

The bottom one has no effect on the query whatsoever.

But, the good new is, no error.

I just noticed the code is totally missing:

PrintDialogPlantChosenLBqry

the query belonging to the second part.

Matt
_____________________________

Here is your last code:

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Const strFirstPartOfQuery As String = "Select * From [ClassOfTradetbl]"


Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = strFirstPartOfQuery
Else
Q.SQL = strFirstPartOfQuery & " Where [ClassOfTrade] In (" & Criteria & ")"
End If

Criteria = ""
Set ctl = Me![PlantChosen]

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
Q.SQL = Q.SQL
Else
Q.SQL = Q.SQL & IIf(Q.SQL = strFirstPartOfQuery, " WHERE", " And") & _
" [Plnt] In (" & Criteria & ")"
End If

Set ctl = Nothing
 
K

Ken Snell [MVP]

OK - Now I admit to being confused.

You are saying you want to use two separate queries, but how do you plan to
get just one result? Or are you just trying to change the SQL of the two
queries independently? I was understanding that you were trying to build a
single SQL statement that included both criteria.

Can you desribe what you want:
(1) one or two queries?
(2) what do you do with the resulting one or two queries?
(3) what is the purpose of the stored queries? are you opening a report
based on those queries later?
 
D

DOYLE60

Ken, I have two codes running on two command buttons. One updates a query
after the user chooses selections from a list box. The other does the same
thing, updating its own query. They both work separately and they both update
their own queries. When I tried to combine them into one code (but still two
queries to update), I failed.

The two queries and the report all work, no problem. The queries are used to
filter the report. This all works. All I want to do is make these two codes
work on one command button instead of two. Once the code works, I will put the
code on the print preview and print command buttons, adding a line to do the
macro (as the user actually chooses one of ten or so reports).

Just in case you were getting confused, this is why I was bewildered that it
was so difficult to get two working codes to work as one. I initially thought
to make functions of the two codes (thus the subject line we are using). But
than I thought it would be best to just make one code to do the job of the two.
No, I do not want one query. I want the code to update the two queries
alreadly working.

I hope this is clear. The two codes that do work are below.

Thanks, and sorry for confusing you. It certainly isn't in my best interest to
waste anyones time here and I deeply appreciate your perserverence.

<Can you desribe what you want:
(1) one or two queries?
(2) what do you do with the resulting one or two queries?
(3) what is the purpose of the stored queries? are you opening a report>

1. Two queries.
2. The queries already work in a line of queirs that filter reports.
3. The purpose is to filter reports. I will add a line to open a report at the
end of the query. A Docmd to do a macro.

Matt


_______________________________________

Code 1 is this (on the click of a command button):

'Enter this without change:
Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = Me![ClassOfTradeChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogClassOfTradeLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [ClassOfTradetbl]"
Else
Q.SQL = "Select * From [ClassOfTradetbl] Where [ClassOfTrade] In(" & Criteria &
");"
End If
______________________________________________________

Code 2 is this (on the click of another command button):

Dim Q As QueryDef, db As Database
Dim Criteria As String
Dim ctl As Control
Dim Itm As Variant

Set ctl = Me![PlantChosen]

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 db = CurrentDb()
Set Q = db.QueryDefs("PrintDialogPlantChosenLBqry")

If Len(Criteria) = 0 Then
Q.SQL = "Select * From [Planttbl]"
Else
Q.SQL = "Select * From [Planttbl] Where [Plnt] In(" & Criteria & ");"
End If

____________________________________
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top