VBA Help (1 Viewer)

armesjr

New member
Local time
Today, 12:59
Joined
Sep 17, 2015
Messages
2
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)))

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"
 

Guus2005

AWF VIP
Local time
Today, 21:59
Joined
Jun 26, 2007
Messages
2,641
have you tried to remove the single quotes in your code?
 

Users who are viewing this thread

Top Bottom