?
How strange
you're not seeing the last module?
here it is updated with the ALL correction: CascadingStates.zip
This is the original I think
Code:
Private Sub MemberEmailList_Click()
On Error GoTo Err_MemberEmailList_Click
Dim myDB As Database
Dim qdf As QueryDef
Dim strWhere As String, strIN As String
Dim flgAll As Boolean
Set myDB = CurrentDb()
strSQL = "SELECT * FROM MemberGroups"
strSQL = "SELECT * FROM qryCitiesAndStates"
'create the WHERE string, stripping off the last comma of the IN string
strWhere = " WHERE [Member Group]in (" & Left(strIN, Len(strIN) - 1) & ")"
strWhere = " WHERE [City] in (" & Left(strIN, Len(strIN) - 1) & ")"
'if "All" is selected, don't add the WHERE condition
If Not flgAll Then
strSQL = strSQL & strWhere
End If
myDB.QueryDefs.Delete "Member-Groups"
Set qdf = myDB.CreateQueryDef("Member-Groups", strSQL)
myDB.QueryDefs.Delete "Cities"
Set qdf = myDB.CreateQueryDef("Cities", strSQL)
DoCmd.OutputTo acOutputQuery, "MemberEmailList", "ExcelWorkbook(*.xlsx)", "\\File02\usfs\Crystal and Excel Reports - Phoenix\CrystalReports\Member Services\MembershipLists\ZipCodeRangeMemberEmailList.xlsx", True, "", , acExportQualityScreen
Exit_MemberEmailList_Click:
Exit Sub
Err_MemberEmailList_Click:
If Err.Number = 3265 Then '*** if the error is the query is missing
Resume Next '*** then skip the delete line and resume on the next line
ElseIf Err.Number = 5 Then
MsgBox "You must select at least one Member Group and/or City"
Resume Exit_MemberEmailList_Click
Else
MsgBox Err.Description '*** write out the error and exit the sub
Resume Exit_MemberEmailList_Click
End If
End Sub
I edited in the City part BUT that's not right.
Code:
Private Sub MemberEmailList_Click()
On Error GoTo Err_MemberEmailList_Click
Dim myDB As Database
Dim qdf As QueryDef
Dim i As Integer
Dim strWhere As String, strIN As String, strSQL As String
Dim flgAll As Boolean
Set myDB = CurrentDb()
strSQL = "SELECT * FROM MemberGroups"
'create the IN string by looping thru the listbox
For i = 0 To MemberGroupSelector.ListCount - 1
If MemberGroupSelector.Selected(i) Then
If MemberGroupSelector.Column(0, i) = " All" Then
flgAll = True
End If
strIN = strIN & "'" & MemberGroupSelector.Column(0, i) & "',"
End If
Next i
'create the WHERE string, stripping off the last comma of the IN string
strWhere = " WHERE [Member Group]in (" & Left(strIN, Len(strIN) - 1) & ")"
'if "All" is selected, don't add the WHERE condition
If Not flgAll Then
strSQL = strSQL & strWhere
End If
myDB.QueryDefs.Delete "Member-Groups"
Set qdf = myDB.CreateQueryDef("Member-Groups", strSQL)
DoCmd.OutputTo acOutputQuery, "MemberEmailList", "ExcelWorkbook(*.xlsx)", "\\File02\usfs\Crystal and Excel Reports - Phoenix\CrystalReports\Member Services\MembershipLists\ZipCodeRangeMemberEmailList.xlsx", True, "", , acExportQualityScreen
Exit_MemberEmailList_Click:
Exit Sub
Err_MemberEmailList_Click:
If Err.Number = 3265 Then '*** if the error is the query is missing
Resume Next '*** then skip the delete line and resume on the next line
ElseIf Err.Number = 5 Then
MsgBox "You must select at least one Member Group and/or City"
Resume Exit_MemberEmailList_Click
Else
MsgBox Err.Description '*** write out the error and exit the sub
Resume Exit_MemberEmailList_Click
End If
End Sub