0
votes

After choosing item from ActiveX combobox by mouse click I would like the combobox to be closed and the item to be chosen.

Here is an example.

enter image description here

I have tried TempCombo_Click event but it is fired AFTER the TempCombo_Change event. And when I select item by click, my search string passed to TempCombo_Change event is empty. So I need something to preserve item selection in TempCombo_Change event.

I use modification of VBA code taken from Autocomplete suggestion in Excel data validation list again

Here is VBA exact code I use to generate the above example.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr
    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("TempCombo")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        'Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            If .ListFillRange = "" Then
                xArr = Split(xStr, Application.International(xlListSeparator))
                Me.TempCombo.List = xArr
            End If
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.TempCombo.DropDown
    End If
End Sub

Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case 9 'tab
            Application.ActiveCell.Offset(0, 1).Activate
        Case 13 'enter
            Application.ActiveCell.Offset(1, 0).Activate
    End Select
End Sub

Private Sub TempCombo_Change()
If Me.TempCombo = "" Then Exit Sub
ActiveSheet.OLEObjects(1).ListFillRange = ""
ActiveSheet.OLEObjects("TempCombo").Object.Clear
ThisWorkbook.ActiveSheet.OLEObjects("TempCombo").Activate

With Me.TempCombo
    If Not .Visible Then Exit Sub
    .Visible = False 'to refresh the drop down
    .Visible = True
    .Activate

'Dump the range into a 2D array
        Dim Arr2D As Variant
        Arr2D = [RangeItems].Value

'Declare and resize the 1D array
        Dim Arr1D As Variant
        ReDim Arr1D(1 To UBound(Arr2D, 1))

'Convert 2D to 1D
        Dim i As Integer
        For i = 1 To UBound(Arr2D, 1)
            Arr1D(i) = Arr2D(i, 1)
        Next

    Dim itm As Variant 'itm is for iterate purpose
    Dim ShortItemList() As Variant 'ShortItemList() is a variable which stores only filtered items
    i = -1
    For Each itm In Arr1D
        If InStr(1, itm, .Value, vbTextCompare) > 0 Or .Value = "" Then
            Debug.Print itm
             i = i + 1
             ReDim Preserve ShortItemList(i)
             ShortItemList(i) = itm
        End If
    Next itm
    .DropDown
End With

On Error Resume Next 'if we filter too much, there will be no items on ShortItemList
ThisWorkbook.ActiveSheet.OLEObjects("TempCombo").Object.List = ShortItemList

End Sub
1
Instead of ActiveSheet.OLEObjects("TempCombo").Object.Clear try ActiveSheet.OLEObjects("TempCombo").Object.List = Array() The .Clear has some odd behavior that if called in TempCombo_Change event it immediately cancels the code execution, which is why you cannot select the item.Pᴇʜ
(1) What do you mean by cancels code execution? The code runs smoothly in my case. (2) I have changed that according to your suggestion and it does not change anything in code effect.Przemyslaw Remin
Well in my tests the .Clear immediately skipped executing TempCombo_Change and re-initiated another TempCombo_Change event that was caused by the .Clear. Which caused the behavior you described.Pᴇʜ

1 Answers

0
votes

This line in the TempCombo_Click event solved the problem:

ActiveCell.Value = ThisWorkbook.ActiveSheet.OLEObjects("TempCombo").Object.Value