I found the below VBA on a post on this forum and need some help in finalizing it for my specific DB. I am new to VBA so I am struggling with what is an easy fix. The first issue is that criteria associated with the Dept ComboBox is not being incorporated into the where statement due to the fact that it is a combox not a listbox. When i changed the combox to a listbox on my form, the criteria was added to to the Where statement correctly. Also, in my Where statement, i don't need each value to be surrounded by a "'".
Thanks in advance for your help.
What it current looks like:
WHERE (((Percentiles.Measure_Category_ID) In ('9','10')) AND ((Percentiles.CG_ID) In ('2','3','4')));
What i need it to look like:
WHERE (((Percentiles.Dept_ID) In (4)) AND((Percentiles.Measure_Category_ID) In (9,10)) AND ((Percentiles.CG_ID) In (2,3,4)))
Thanks in advance for your help.
What it current looks like:
WHERE (((Percentiles.Measure_Category_ID) In ('9','10')) AND ((Percentiles.CG_ID) In ('2','3','4')));
What i need it to look like:
WHERE (((Percentiles.Dept_ID) In (4)) AND((Percentiles.Measure_Category_ID) In (9,10)) AND ((Percentiles.CG_ID) In (2,3,4)))
Code:
Private Sub Final_Output_Click()
Dim ctlSource As Control
Dim i As Variant
Dim intFilterFlag As Integer
Dim strDeptParam As String
Dim strCGParam As String
Dim strMCParam As String
Dim strWhereClause As String
Dim strSQL As String
'Select Contents from Dept Combobox
Set ctlSource = Me!Combo_Dept
strDeptParam = ""
intFilterFlag = 1
For Each i In ctlSource.ItemsSelected
strDeptParam = strDeptParam & ctlSource.ItemData(i) & "','"
Next i
If Len(strDeptParam) > 0 Then
strDeptParam = Left(strDeptParam, Len(strDeptParam) - 3)
intFilterFlag = intFilterFlag + 1
End If
'Define Filter/Where requirements for Recordset
Select Case intFilterFlag
Case Is = 1
strWhereClause = ""
Case Is = 2
strWhereClause = "([Percentiles].Dept_ID) In ('" & strDeptParam & "')"
End Select
'Select Contents from MC Listbox
Set ctlSource = Me!List_MC
strMCParam = ""
intFilterFlag = 1
For Each i In ctlSource.ItemsSelected
strMCParam = strMCParam & ctlSource.ItemData(i) & "','"
Next i
If Len(strMCParam) > 0 Then
strMCParam = Left(strMCParam, Len(strMCParam) - 3)
intFilterFlag = intFilterFlag + 1
End If
'Define Filter/Where requirements for Recordset
Select Case intFilterFlag
Case Is = 1
strWhereClause = strWhereClause
Case Is = 2
If strWhereClause = "" Then
strWhereClause = "([Percentiles].Measure_Category_ID) In ('" & strMCParam & "')"
Else
strWhereClause = strWhereClause & " AND ([Percentiles].Measure_Category_ID) In ('" & strMCParam & "')"
End If
End Select
'Select Contents from List CG
Set ctlSource = Me!List_CG
strCGParam = ""
intFilterFlag = 1
For Each i In ctlSource.ItemsSelected
strCGParam = strCGParam & ctlSource.ItemData(i) & "','"
Next i
If Len(strCGParam) > 0 Then
strCGParam = Left(strCGParam, Len(strCGParam) - 3)
intFilterFlag = intFilterFlag + 1
End If
'Define Filter/Where requirements for Recordset
Select Case intFilterFlag
Case Is = 1
strWhereClause = strWhereClause
Case Is = 2
If strWhereClause = "" Then
strWhereClause = "([Percentiles].CG_ID'" & strCGParam & "')"
Else
strWhereClause = strWhereClause & " AND ([Percentiles].CG_ID) In ('" & strCGParam & "')"
End If
End Select
If strWhereClause = "" Then
Else
strWhereClause = " WHERE (" & strWhereClause & ")"
End If
strSQL = "SELECT Percentiles.[Standard Department Name], Percentiles.[Measure Category], Percentiles.Measure, Percentiles.[Compare Group], Percentiles.[Percentile - 10th], Percentiles.[Percentile - 25th], Percentiles.[Percentile - 50th], Percentiles.[Sample Size], Percentiles.[Compare Group Average], Percentiles.[Standard Deviation] FROM ((Percentiles INNER JOIN Compare_Groups ON Percentiles.CG_ID = Compare_Groups.CG_ID) INNER JOIN Department_Names ON Percentiles.Dept_ID = Department_Names.Dept_ID) INNER JOIN Measure_Categories ON Percentiles.Measure_Category_ID = Measure_Categories.Measure_Category_ID" & strWhereClause & ";"
Dim qdfTemp As QueryDef
CurrentDb.QueryDefs.Delete "Test"
Set qdfTemp = CurrentDb.CreateQueryDef("Test", strSQL)
' Run the query.
DoCmd.OpenQuery "Test"