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
ExpExchHelpAsked:
Who is Participating?
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 ConnectWise

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
 
ExpExchHelpAuthor Commented:
Absolutely perfect solution!!   Thousand thanks, Christian.  :)

EEH
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.