3 list boxes 1 answer

D

Dan @BCBS

My code almost works.
This code is from a command button on a form. The user has 3 list boxes to
choose form. My results reflect two of the choices. COuld you please help
me add the third.
Toward the bottom is where I'm struggling: stLinkCriteria = "[gbulocation] "
& stAreaList & " and [insurancetype] " & stProductList

When I try to add [Reviewer] " & stReviewerList - I get a Compile Error:
Expected: end of statement.......

Please help I'm so close.....



Dim stDocName As String
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim stArea As Variant
Dim stProduct As Variant
Dim stReviewer As Variant

stDocName = "Report1"
stAreaList = ""
stProductList = ""
stReviewerList = ""

If IsNull(txtStart) Or IsNull(txtEnd) Then
MsgBox "Please enter start and end dates"
Exit Sub
Else
X = 0
For Each stArea In ListArea.ItemsSelected
If X = 0 Then
stAreaList = "In('" & ListArea.ItemData(stArea) & "'"
Else
stAreaList = stAreaList & ",'" & ListArea.ItemData(stArea) &
"'"
End If
X = X + 1
Next stArea

If X > 0 Then stAreaList = stAreaList & ")"

Y = 0
For Each stProduct In ListProduct.ItemsSelected
If Y = 0 Then
stProductList = "In('" & ListProduct.ItemData(stProduct) & "'"
Else
stProductList = stProductList & ",'" &
ListProduct.ItemData(stProduct) & "'"
End If
Y = Y + 1
Next stProduct
If Y > 0 Then stProductList = stProductList & ")"


Z = 0
For Each stReviewer In ListReviewer.ItemsSelected
If Z = 0 Then
stReviewerList = "In('" & ListReviewer.ItemData(stReviewer)
& "'"
Else
stReviewerList = stReviewerList & ",'" &
ListReviewer.ItemData(stReviewer) & "'"
End If
Z = Z + 1
Next stReviewer
If Z > 0 Then stReviewerList = stReviewerList & ")"

If stAreaList <> ")" And stProductList <> ")" And stReviewerList <>
")" Then
stLinkCriteria = "[gbulocation] " & stAreaList & " and
[insurancetype] " & stProductList
ElseIf stAreaList = ")" And stProductList <> ")" Then
stLinkCriteria = "[insurancetype] " & stProductList
ElseIf stAreaList <> ")" And stProductList = ")" Then
stLinkCriteria = "[gbulocation] " & stAreaList
End If

DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria
End If
 
S

SteveS

Hi Dan,
When I try to add [Reviewer] " & stReviewerList - I get a Compile Error:
Expected: end of statement.......
Click to expand...

Its not clear ,but what it means is you are missing an "End If" statement.

This is the section of code that caused the error:
If IsNull(txtStart) Or IsNull(txtEnd) Then
MsgBox "Please enter start and end dates"
Exit Sub
Else
X = 0
For Each stArea In ListArea.ItemsSelected
If X = 0 Then
Click to expand...


At the top of every page of code you should have:

Option Compare Database
Option Explicit


The "Option Explicit" requires variable declarations. You were missing a few
Dim statements.

I noticed you check to see if start and ending dates are entered, but you
aren't using them (yet?).

I modified your code - sorry, but sometimes its hard to resist....<g>

Anyway, here is the code. Watch for line wrap!!!

'-----beg code---------
On Error GoTo MyBad

Dim stDocName As String

'these need to be declared also
Dim stAreaList As String
Dim stProductList As String
Dim stReviewerList As String
Dim stLinkCriteria As String

'first time thru loop?
Dim FirstTime As Boolean

Dim stArea As Variant
Dim stProduct As Variant
Dim stReviewer As Variant

stDocName = "Report1"
stAreaList = ""
stProductList = ""
stReviewerList = ""

'??? are you going to use these dates
If IsNull(txtstart) Or IsNull(txtend) Then
MsgBox "Please enter start and end dates"
Exit Sub
End If

'get areas selected in ListArea
FirstTime = True
For Each stArea In ListArea.ItemsSelected
If FirstTime Then
stAreaList = "In('" & ListArea.ItemData(stArea) & "'"
FirstTime = False
Else
stAreaList = stAreaList & ",'" & ListArea.ItemData(stArea) & "'"
End If
Next stArea
If Not FirstTime Then
stAreaList = stAreaList & ")"
End If

'get products in ListProduct
FirstTime = True
For Each stProduct In ListProduct.ItemsSelected
If FirstTime Then
stProductList = "In('" & ListProduct.ItemData(stProduct) & "'"
FirstTime = False
Else
stProductList = stProductList & ",'" &
ListProduct.ItemData(stProduct) & "'"
End If
Next stProduct
If Not FirstTime Then
stProductList = stProductList & ")"
End If

'get reviewer in ListReviewer
FirstTime = True
For Each stReviewer In ListReviewer.ItemsSelected
If FirstTime Then
stReviewerList = "In('" & ListReviewer.ItemData(stReviewer) & "'"
FirstTime = False
Else
stReviewerList = stReviewerList & ",'" &
ListReviewer.ItemData(stReviewer) & "'"
End If
Next stReviewer
If Not FirstTime Then
stReviewerList = stReviewerList & ")"
End If


'create criteria string
'stAreaList
If Len(Trim(Nz(stAreaList, ""))) > 0 Then
stLinkCriteria = "[gbulocation] " & stAreaList & " And "
End If

'stProductList
If Len(Trim(Nz(stProductList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[insurancetype] " & stProductList
& " And "
End If

'stReviewerList
If Len(Trim(Nz(stReviewerList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[Reviewer] " & stReviewerList & "
And "
End If

'now remove the last 'And' and spaces
stLinkCriteria = Left(stLinkCriteria, Len(stLinkCriteria) - 5)

'-------------------------
' for debugging - delete after code runs without errors
' MsgBox stLinkCriteria
'-------------------------

'open report in preview mode
DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria

Exit_Mybad:
Exit Sub

Err_MyBad:
MsgBox Err.Description
Resume Exit_Mybad
'-----end code---------



HTH
 
D

Dan @BCBS

I should know the answer to this but I cannot remember:
I'm getting the error: Compile Error Label not defined..
How do I define the cmdKeyIndicators...???


Private Sub cmdKeyIndicators_Click()
On Error GoTo Err_cmdKeyIndicators_Click

Dim stDocName As String

'these need to be declared also
Dim stAreaList As String
Dim stProductList As String
Dim stReviewerList As String
Dim stLinkCriteria As String

'first time thru loop?
Dim FirstTime As Boolean

Dim stArea As Variant
Dim stProduct As Variant
Dim stReviewer As Variant

stDocName = "Report1"
stAreaList = ""
stProductList = ""
stReviewerList = ""

'??? are you going to use these dates
If IsNull(txtStart) Or IsNull(txtEnd) Then
MsgBox "Please enter start and end dates"
Exit Sub
End If

'get areas selected in ListArea
FirstTime = True
For Each stArea In ListArea.ItemsSelected
If FirstTime Then
stAreaList = "In('" & ListArea.ItemData(stArea) & "'"
FirstTime = False
Else
stAreaList = stAreaList & ",'" & ListArea.ItemData(stArea) & "'"
End If
Next stArea
If Not FirstTime Then
stAreaList = stAreaList & ")"
End If

'get products in ListProduct
FirstTime = True
For Each stProduct In ListProduct.ItemsSelected
If FirstTime Then
stProductList = "In('" & ListProduct.ItemData(stProduct) & "'"
FirstTime = False
Else
stProductList = stProductList & ",'" & ListProduct.ItemData(stProduct) & "'"
End If
Next stProduct
If Not FirstTime Then
stProductList = stProductList & ")"
End If

'get reviewer in ListReviewer
FirstTime = True
For Each stReviewer In ListReviewer.ItemsSelected
If FirstTime Then
stReviewerList = "In('" & ListReviewer.ItemData(stReviewer) & "'"
FirstTime = False
Else
stReviewerList = stReviewerList & ",'" & ListReviewer.ItemData(stReviewer) &
"'"
End If
Next stReviewer
If Not FirstTime Then
stReviewerList = stReviewerList & ")"
End If


'create criteria string
'stAreaList
If Len(Trim(Nz(stAreaList, ""))) > 0 Then
stLinkCriteria = "[gbulocation] " & stAreaList & " And "
End If

'stProductList
If Len(Trim(Nz(stProductList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[insurancetype] " & stProductList & " And "
End If

'stReviewerList
If Len(Trim(Nz(stReviewerList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[Reviewer] " & stReviewerList & " " And ""
End If

'now remove the last 'And' and spaces
stLinkCriteria = Left(stLinkCriteria, Len(stLinkCriteria) - 5)

'-------------------------
' for debugging - delete after code runs without errors
' MsgBox stLinkCriteria
'-------------------------

'open report in preview mode
DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria

Exit_cmdKeyIndicators:
Exit Sub

Err_cmdKeyIndicators:
MsgBox err.Description
Resume Exit_cmdKeyIndicators

End Sub


SteveS said:
Hi Dan,
When I try to add [Reviewer] " & stReviewerList - I get a Compile Error:
Expected: end of statement.......
Click to expand...

Its not clear ,but what it means is you are missing an "End If" statement.

This is the section of code that caused the error:
If IsNull(txtStart) Or IsNull(txtEnd) Then
MsgBox "Please enter start and end dates"
Exit Sub
Else
X = 0
For Each stArea In ListArea.ItemsSelected
If X = 0 Then
Click to expand...


At the top of every page of code you should have:

Option Compare Database
Option Explicit


The "Option Explicit" requires variable declarations. You were missing a few
Dim statements.

I noticed you check to see if start and ending dates are entered, but you
aren't using them (yet?).

I modified your code - sorry, but sometimes its hard to resist....<g>

Anyway, here is the code. Watch for line wrap!!!

'-----beg code---------
On Error GoTo MyBad

Dim stDocName As String

'these need to be declared also
Dim stAreaList As String
Dim stProductList As String
Dim stReviewerList As String
Dim stLinkCriteria As String

'first time thru loop?
Dim FirstTime As Boolean

Dim stArea As Variant
Dim stProduct As Variant
Dim stReviewer As Variant

stDocName = "Report1"
stAreaList = ""
stProductList = ""
stReviewerList = ""

'??? are you going to use these dates
If IsNull(txtstart) Or IsNull(txtend) Then
MsgBox "Please enter start and end dates"
Exit Sub
End If

'get areas selected in ListArea
FirstTime = True
For Each stArea In ListArea.ItemsSelected
If FirstTime Then
stAreaList = "In('" & ListArea.ItemData(stArea) & "'"
FirstTime = False
Else
stAreaList = stAreaList & ",'" & ListArea.ItemData(stArea) & "'"
End If
Next stArea
If Not FirstTime Then
stAreaList = stAreaList & ")"
End If

'get products in ListProduct
FirstTime = True
For Each stProduct In ListProduct.ItemsSelected
If FirstTime Then
stProductList = "In('" & ListProduct.ItemData(stProduct) & "'"
FirstTime = False
Else
stProductList = stProductList & ",'" &
ListProduct.ItemData(stProduct) & "'"
End If
Next stProduct
If Not FirstTime Then
stProductList = stProductList & ")"
End If

'get reviewer in ListReviewer
FirstTime = True
For Each stReviewer In ListReviewer.ItemsSelected
If FirstTime Then
stReviewerList = "In('" & ListReviewer.ItemData(stReviewer) & "'"
FirstTime = False
Else
stReviewerList = stReviewerList & ",'" &
ListReviewer.ItemData(stReviewer) & "'"
End If
Next stReviewer
If Not FirstTime Then
stReviewerList = stReviewerList & ")"
End If


'create criteria string
'stAreaList
If Len(Trim(Nz(stAreaList, ""))) > 0 Then
stLinkCriteria = "[gbulocation] " & stAreaList & " And "
End If

'stProductList
If Len(Trim(Nz(stProductList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[insurancetype] " & stProductList
& " And "
End If

'stReviewerList
If Len(Trim(Nz(stReviewerList, ""))) > 0 Then
stLinkCriteria = stLinkCriteria & "[Reviewer] " & stReviewerList & "
And "
End If

'now remove the last 'And' and spaces
stLinkCriteria = Left(stLinkCriteria, Len(stLinkCriteria) - 5)

'-------------------------
' for debugging - delete after code runs without errors
' MsgBox stLinkCriteria
'-------------------------

'open report in preview mode
DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria

Exit_Mybad:
Exit Sub

Err_MyBad:
MsgBox Err.Description
Resume Exit_Mybad
'-----end code---------



HTH
Click to expand...
 
S

Stefan Hoffmann

hi Dan,
I should know the answer to this but I cannot remember:
I'm getting the error: Compile Error Label not defined..
How do I define the cmdKeyIndicators...???
Click to expand...
Private Sub cmdKeyIndicators_Click()
On Error GoTo Err_cmdKeyIndicators_Click
Click to expand...
lots of code deleted
DoCmd.OpenReport stDocName, acPreview, , stLinkCriteria

Exit_cmdKeyIndicators:
Exit Sub

Err_cmdKeyIndicators:
Click to expand...
This label must have be the same as in the On Error statement.
MsgBox err.Description
Resume Exit_cmdKeyIndicators

End Sub
Click to expand...


mfG
--> stefan <--
 
D

Dan @BCBS

Your comments do not show me anything to change except " lots of code deleted "
Everything else you posted is the same as what I had..????

All I'm trying to do is to Define A Label.....

Thanks
 
S

Stefan Hoffmann

hi Dan,
Your comments do not show me anything to change except " lots of code deleted "
Everything else you posted is the same as what I had..????
Click to expand...
Take a closer look at it.
Your label declaration in the On Error statement has a trailing
"_Click". This is missing here.


mfG
--> stefan <--
 
D

Dan @BCBS

I could have sworn I checked that I must have forgotten the colon....

Please, one last question:
Now I'm getting a Type Mismatch on the "Reviewer" Value.
I know I need to add a comma/hyphen or something, but I'm not sure where..
 
D

Dan @BCBS

I thought I tried that, I must have forgotten he colon at the end.

Please one last question:
I'm getting the "Type Mismatch" error on the Reviewer...
I know I need to change the type with a comma and hyphen?? But I don't know
where...


Dan
 
S

SteveS

Dan,
I'm getting the "Type Mismatch" error on the Reviewer...
I know I need to change the type with a comma and hyphen?? But I don't know
where...
Click to expand...

When you copied the code from the NG and pasted it in your MDB, one of the
lines had "wrapped" and Access added extra double quotes.


WRONG: (the 'And' part)
....& "[Reviewer] " & stReviewerList & " " And ""


RIGHT:
....& "[Reviewer] " & stReviewerList & " And "


It should run now.
 
D

Dan @BCBS

Perfect - thank you....

SteveS said:
Dan,
I'm getting the "Type Mismatch" error on the Reviewer...
I know I need to change the type with a comma and hyphen?? But I don't know
where...
Click to expand...

When you copied the code from the NG and pasted it in your MDB, one of the
lines had "wrapped" and Access added extra double quotes.


WRONG: (the 'And' part)
...& "[Reviewer] " & stReviewerList & " " And ""


RIGHT:
...& "[Reviewer] " & stReviewerList & " And "


It should run now.
Click to expand...
 

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

Similar Threads

3 choices 3
Type Mismatch 5
DoCmd.SendObject 2
DoCmd.OpenQuery 4
Combine 3 List box Choices 1
records per list 4
ItemsSelected 1
Duplicates being produced 2

Top