Update SQL/VBA to accommodate cascading drop-down values in combo boxes

Experts:

I need some assistance with modifying my VBA/SQL for an Excel spreadsheet.

First things first... I do NOT want to use Excel's built-in "Auto Filters"... reason for such is not important in this thread though.

Instead, I would like to modify my VBA/SQL to utilize the principle of cascading drop-down menus for the combo boxes (Active X controls).

Current Process:
1. Select values from the drop-down boxes (travel category, state, or city).
2. Click on "Show Data" to display matching records (listed in tab "SourceData").
3. Right now, based on the source data, any non-existing record combination shows as "No matching records were found".

What I envision/would like to change in the VBA/SQL:

Instead of arbitrarily finding out that a record combination does not  exist, I would like to apply the principle of "cascading drop-down" menus for showing/not showing available filter values.  Please see some additional explanations (i.e., screenshots) on the tab "Source Data with explanations".

How do I modify the VBA/SQL in order to not incur "no matching records found"?    I appreciate any assistance!

Thank you,
EEH
Quick-Filter.xlsm
ExpExchHelpAnalystAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

BitsqueezerCommented:
Hi,

as I had some troubles saving your file due to the fact that I have three Excel versions on my computer here is the code instead. Simply exchange the complete code in Sheet5 (QuickFilter) with the one below.

I would recommend to add "Option Explicit" to each module and compile the code and add declarations for all variables.

Cheers,

Christian


Private Sub cmbState_Change()
    If Me.cmbState <> "" Then
        Me.cmbCity.Enabled = True
        RefreshCity Me.cmbState
    Else
        Me.cmbCity.Enabled = False
    End If
End Sub

Private Sub cmbTravelCategory_Change()
    If Me.cmbTravelCategory <> "" Then
        Me.cmbState.Enabled = True
        RefreshState Me.cmbTravelCategory
    Else
        Me.cmbState.Enabled = False
    End If
End Sub

Private Sub cmdClearData_Click()
    
    'Clear the data
    Sheets("QuickFilter").Visible = True
    Sheets("QuickFilter").Select
    Range("dataSet").Select
    Range(Selection, Selection.End(xlDown)).ClearContents
    
End Sub

Private Sub cmdShowData_Click()
    
    'Populate data
    strSQL = "SELECT * FROM [SourceData$] WHERE "
    If cmbTravelCategory.Text <> "" Then
        strSQL = strSQL & " [Travel Category]='" & cmbTravelCategory.Text & "'"
    End If
    
    
    If cmbState.Text <> "" Then
        If cmbTravelCategory.Text <> "" Then
            strSQL = strSQL & " AND [State]='" & cmbState.Text & "'"
        Else
            strSQL = strSQL & " [State]='" & cmbState.Text & "'"
        End If
    End If

    If cmbCity.Text <> "" Then
        If cmbTravelCategory.Text <> "" Or cmbState.Text <> "" Then
            strSQL = strSQL & " AND [City]='" & cmbCity.Text & "'"
        Else
            strSQL = strSQL & " [City]='" & cmbCity.Text & "'"
        End If
    End If
    
    
    If cmbTravelCategory.Text <> "" Or cmbState.Text <> "" Or cmbCity.Text <> "" Then
        'now extract data
        closeRS
        
        OpenDB
        
        rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
        If rs.RecordCount > 0 Then
            Sheets("QuickFilter").Visible = True
            Sheets("QuickFilter").Select
            Range("dataSet").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
            
            'Now putting the data on the sheet
            ActiveCell.CopyFromRecordset rs
        Else
            MsgBox "No matching records were found.", vbExclamation + vbOKOnly
            Exit Sub
        End If

        'Now getting the totals using Query
        If cmbTravelCategory.Text <> "" And cmbState.Text <> "" And cmbCity.Text <> "" Then
            strSQL = "SELECT Count([SourceData$].[Trip ID]) AS [CountOfTrip ID], [SourceData$].[Resolved] " & _
            " FROM [SourceData$] WHERE ((([SourceData$].[Travel Category]) = '" & cmbTravelCategory.Text & "' ) And " & _
            " (([SourceData$].[State]) =  '" & cmbState.Text & "' ) And (([SourceData$].[City]) =  '" & cmbCity.Text & "' )) " & _
            " GROUP BY [SourceData$].[Resolved];"
            
            closeRS
            OpenDB
        
        End If
    End If
End Sub

Private Sub RefreshState(strFilter As String)
    Dim strSQL As String
    
    If strFilter = "" Then
        cmbState.Clear
    Else
        strSQL = "Select Distinct [State] From [SourceData$] WHERE [Travel Category] = '" & strFilter & "' Order by [State]"
        closeRS
        OpenDB
        cmbState.Clear
        
        rs.Open strSQL, cnn, adOpenForwardOnly, adLockReadOnly
        If rs.RecordCount > 0 Then
            Do While Not rs.EOF
                cmbState.AddItem rs.Fields(0)
                rs.MoveNext
            Loop
        Else
            Me.cmbState.Enabled = False
        End If
    End If
End Sub

Private Sub RefreshCity(strFilter As String)
    Dim strSQL As String
    
    If strFilter = "" Then
        cmbCity.Clear
    Else
        strSQL = "Select Distinct [City] From [SourceData$] WHERE [Travel Category] = '" & Me.cmbTravelCategory & "' AND [State] = '" & strFilter & "' Order by [City]"
        closeRS
        OpenDB
        cmbCity.Clear
        
        rs.Open strSQL, cnn, adOpenForwardOnly, adLockReadOnly
        If rs.RecordCount > 0 Then
            Do While Not rs.EOF
                cmbCity.AddItem rs.Fields(0)
                rs.MoveNext
            Loop
        Else
            Me.cmbCity.Enabled = False
        End If
    End If
End Sub


Private Sub cmdRefreshFilters_Click()
        
    'Clear the filters
    cmbTravelCategory.Clear
    cmbState.Clear
    cmbState.Enabled = False
    cmbCity.Clear
    cmbCity.Enabled = False
                    
          
    strSQL = "Select Distinct [Travel Category] From [SourceData$] Order by [Travel Category]"
    closeRS
    OpenDB
    cmbTravelCategory.Clear
    
    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount > 0 Then
        Do While Not rs.EOF
            cmbTravelCategory.AddItem rs.Fields(0)
            rs.MoveNext
        Loop
    Else
        MsgBox "No matching records were found.", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    RefreshState Me.cmbTravelCategory
    
    RefreshCity Me.cmbState
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ExpExchHelpAnalystAuthor Commented:
Absolutely perfect solution!!   Thousand thanks, Christian.  :)

EEH
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
SQL

From novice to tech pro — start learning today.