If I understand you correctly, with a value selected in the ComboBox, you want to click on the ComboBox again, click on the value and have the value deleted so that the entire list is available and displayed. This can be achieved with the ComboBox's GotFocus event.
Below is the complete code, instructions and several improvements:
1. The ListRange variable now holds the range of values used by the ComboBox's List property, and is initialised in one place instead of using the same code in different places. As coded below, the values are in Sheet1 starting at A2 to the last populated cell in column A. A named range could be assigned to ListRange.
2. The ListRowsMaximum variable stores the ComboBox's initial ListRows property value, which is the maximum number of displayed rows.
The combo box is an ActiveX Combo Box placed on Sheet1 with the following properties:
Name = ComboBox1
ListFillRange = blank
MatchEntry = 2 - fmMatchEntryNone
MatchRequired = False
Put this code in the module of the sheet containing the combo box.
VBA Code:
Option Explicit
Dim IsArrow As Boolean
Dim ListRowsMaximum As Long
Dim ListRange As Range
Private Sub Init_Settings()
'ListRange holds the cells to use in the combobox List
With Worksheets("Sheet1")
Set ListRange = .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
End With
'ListRowsMaximum is the original ListRows value - maximum number of displayed rows
If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
End Sub
Private Sub ComboBox1_GotFocus()
If ListRange Is Nothing Then Init_Settings
'Initialise the combobox List with cell values from ListRange
With Me.ComboBox1
.List = ListRange.Value
.ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
.Text = ""
End With
End Sub
Private Sub ComboBox1_DropButtonClick()
If ListRange Is Nothing Then Init_Settings
With Me.ComboBox1
.List = ListRange.Value
.ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
.DropDown
End With
End Sub
Private Sub ComboBox1_Change()
Dim i As Long
'Update the combobox List to only the items containing the current Text
If Not IsArrow Then
With Me.ComboBox1
.List = ListRange.Value
If Len(.Text) Then
For i = .ListCount - 1 To 0 Step -1
If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
Next
End If
.DropDown
.ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
End With
End If
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
With Me.ComboBox1
.ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
End With
IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
If KeyCode = vbKeyReturn Then
Me.ComboBox1.List = ListRange.Value
ElseIf KeyCode = vbKeyTab Then
'Tab key selects first displayed item or highlighted item
With Me.ComboBox1
If .ListIndex = -1 Then
.Value = .List(0)
Else
.Value = .List(.ListIndex)
End If
End With
KeyCode = vbKeyReturn
End If
End Sub
John,
I based my code on the one you provided above and it works for the cell that the Combo Box is in. Is it possible to add a line of code to the above to have the Combo Box search feature show up in multiple cells in a column?
Previously, I had the below vba code where the Combo Box list would show up when you double clicked a cell, but it would only search the beginning of each item instead of all the characters from the text list (similar to the original post). Any thoughts how how to manipulate my code below or your code?
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains
'a data validation list
Cancel = True
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.TempCombo.DropDown
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
'=========================================
Private Sub TempCombo_LostFocus()
With Me.TempCombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End Sub
'====================================
'Optional code to move to next cell
'if Tab or Enter are pressed
'from code by Ted Lanham
'***NOTE: if KeyDown causes problems,
'change to KeyUp
'Table with numbers for other keys
'such as Right Arrow (39)
'
https://msdn.microsoft.com/en-us/library/aa243025(v=vs.60).aspx
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Select Case KeyCode
Case 9 'Tab
ActiveCell.Offset(0, 1).Activate
Case 13 'Enter
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub
