Pony99CA
Pony99CA

Reputation: 89

How can I determine the difference between typing into a combo box and selecting from a drop down in Access VBA?

This question was asked in the topic with a similar name earlier, but the answer provided didn't really indicate HOW those events would help determine whether somebody was typing in the combo box or selecting an item in the list. I think that it really answered the other question about how to determine when somebody was done typing, but without seeing the event handlers, I can't be sure.

Unfortunately, I'm new here and don't have enough reputation to post a comment asking for clarification, so I have to start a new question. Here's what I'm trying to do:

I have a form with a combo box in the Header and, as I type in the combo box, I want the characters that I've typed to be used as a filter on the Details part of the form. Both the combo box control source and the form's record source use the same query string.

I've tried numerous iterations of the code below, but I can't get it to work correctly.

Private Sub cmbAppName_Change()
    Dim strApp As String
    Dim nSelStart As Integer
    Dim nSelLen As Integer
    Dim nSelected As Integer
    Dim strMsg As String

    On Error GoTo ERR_SUB

    strMsg = ""

    Me.cmbAppName.SetFocus

    ' Get current selection details
    nSelStart = Me.cmbAppName.SelStart
    nSelLen = Me.cmbAppName.SelLength
    nSelected = Me.cmbAppName.ListIndex

    Me.cmbAppName.SetFocus
    strApp = Nz(Me.cmbAppName.Text, "")

    Debug.Print "Index = " & nSelected & "; SelStart = " & nSelStart & "; SelLen = " & nSelLen
    If nSelected = -1 Then
        Debug.Print "Change by typing:  " & strApp
    Else
        Debug.Print "Change by list selection:  " & strApp
    End If

    ' Get the part of the text that the user has typed
    If nSelStart > 0 Then
        strApp = Left(strApp, nSelStart)
        Debug.Print "App piece = '" & strApp & "'"
    End If

    ' If there is text, set a filter (MatchAppName = InStr(strApp, datbase_column_value)
    If strApp <> "" Then
        Me.Filter = "MatchAppName('" & strApp & "', " & DCApplications_Application_Col & ") > 0"
        Me.FilterOn = True
'        Me.txtApplication.SetFocus
'        Call DoCmd.FindRecord(strApp, acStart, False, acSearchAll, False, acCurrent, True)
'        Me.cmbAppName.SetFocus
    Else
        Me.Filter = ""
        Me.FilterOn = False
    End If

EXIT_SUB:
    ' Restore the selection in the combo box's text box
    Me.cmbAppName.SetFocus
    Me.cmbAppName.SelStart = nSelStart
    Me.cmbAppName.SelLength = nSelLen
    Exit Sub

ERR_SUB:
    If ERR.Number = 2185 Then
        strApp = Nz(Me.cmbAppName.Value, "")
        Me.cmbAppName.SetFocus
        Debug.Print "Using " & strApp
        Resume Next
    End If

    Me.Filter = ""
    Me.FilterOn = False
    Debug.Print ErrorMessage(ERR.Description, "cmbAppName_Change", ERR.Number, "Value = '" & Me.cmbAppName.Value & "'", False)
    Resume EXIT_SUB
End Sub ' cmbAppName_Change

As you can see from the error handling code, I'd often get an error 2185 telling me that my control didn't have focus when using the Text property despite having a SetFocus call right before it.

If somebody selects from the list (either by clicking or moving the selection), I'd like to go to that record, but I at least need the above piece working first.

Upvotes: 0

Views: 409

Answers (2)

Pony99CA
Pony99CA

Reputation: 89

After searching the Web, I found out that a Details section with zero records causes the 2185 error. Apparently, filtering like that causes problems when all records are filtered out.

The solutions on the Web said that you can set the Allow Additions property of the form to True, but that always displays one row in the Details section. This can be especially confusing if the rows in the Details section contain controls, which will be displayed in the "addition" row. Also, I would still get an error typing additional characters after the one that caused the Details section to have zero records.

Eventually, I replaced the combo box with a simple text control to filter the Details section. When the Details section has rows, I turn Allow Additions off and make the controls visible; when it doesn't have rows, I turn Allow Additions on and hide the controls.

Here's the code that I used:

Private Sub txtApplicationFilter_Change()
    Dim strApp As String
    Dim nSelStart As Integer
    Dim nSelLen As Integer
    Dim strFilter As String
    Dim strQuery As String
    Dim strWhere As String
    Dim nRecs As Integer
    
    On Error GoTo ERR_SUB
    
    ' Save text selection
    nSelStart = Me.txtApplicationFilter.SelStart
    nSelLen = Me.txtApplicationFilter.SelLength
   
    ' Get application name typed and selection information
    strApp = Nz(Me.txtApplicationFilter.Text, "")
    strFilter = "[" & DCApplications_Application_Col & "] LIKE '*" & EscapeQuotes(strApp) & "*'"
    nRecs = DCount("[" & DCApplications_Application_Col & "]", LocalTableName(DCApplications_Tab), strFilter)

    ' Kludge code to prevent various errors (like 2185) when no records are returned in the form
    Call UpdateList(nRecs)
    
    ' Update the record source to reflect the filtered list of apps
    strWhere = " WHERE APPS." & strFilter
    strQuery = strSelect & strFrom & strWhere & strOrderBy
    Me.RecordSource = strQuery

    ' 20200423 SHM: Restore or update filter to avoid  issues with Delete and Backspace and applications with spaces in their names
    Me.txtApplicationFilter.SetFocus
    Me.txtApplicationFilter = strApp
    Me.txtApplicationFilter.SelStart = nSelStart
    Me.txtApplicationFilter.SelLength = nSelLen

EXIT_SUB:
    Me.btnAddNew.enabled = (Nz(Me.txtApplicationFilter, "") <> "")
    Exit Sub
    
ERR_SUB:
    ' NOTE:  ErrorMessage is a helper function that basically displays a form displaying the error
    Call ErrorMessage(ERR.Description, "txtApplicationFilter_Change", ERR.Number, "Filter = " & strApp & " Records = " & nRecs)
    
    Resume EXIT_SUB
    Resume Next
End Sub ' txtApplicationFilter_Change

Private Sub UpdateList(nRecs As Integer)
    Dim bShowControls As Boolean
    
    On Error GoTo ERR_SUB
    
    bShowControls = (nRecs > 0)
    
    ' Kludge code to turn off checkbox control source
    If bShowControls Then
        strSelect = strSelectStart & ", (" & strAppUser & ") AS " & strCtrlSource
        Me.chkTestedByMe.ControlSource = strCtrlSource
    Else
        strSelect = strSelectStart
        Me.chkTestedByMe.ControlSource = ""
    End If
    
    ' Kludge code to prevent various errors (like 2185) when no records are returned in the form
    ' Turning on AllowAdditions prevents errors when no records are returned.
    ' However, that puts an empty row in the form, but the controls are showing, so we have to hide them to prevent confusing the user.
    Me.AllowAdditions = Not bShowControls
    Me.btnAddExisting.visible = bShowControls
    Me.chkTestedByMe.visible = bShowControls
EXIT_SUB:
    Exit Sub
    
ERR_SUB:
    Call ErrorMessage(ERR.Description, "UpdateList", ERR.Number, " Records = " & nRecs)
    
    Resume EXIT_SUB
    Resume Next
End Sub ' UpdateList

Upvotes: 1

Susilo
Susilo

Reputation: 866

I would use a work around to settle this issue

A simple code bellow demonstrate the work around using Tag property of Combo Box and keypress event along with change event, I hope it can be applied in your code

Private Sub Combo2_Change()
    If Combo2.Tag = 1 Then
        Text4 = "change - from key"
    Else
        Text4 = "change - from select"
    End If
    Combo2.Tag = 0
End Sub

Private Sub Combo2_KeyPress(KeyAscii As Integer)
    Combo2.Tag = 1
End Sub

Don't forget to set Tag property of Combo Box to 0 on design view to avoid error at comparing empty Tag with number

Upvotes: 0

Related Questions