I adapted the answer by ChrisB. Like in his example a temporary combobox is made visible when a cell is clicked. Additionally:
Option Explicit_x000D_
_x000D_
Private Const DATA_RANGE = "A1:A16"_x000D_
Private Const DROPDOWN_RANGE = "F2:F10"_x000D_
Private Const HELP_COLUMN = "$G"_x000D_
_x000D_
_x000D_
Private Sub Worksheet_SelectionChange(ByVal target As Range)_x000D_
Dim xWs As Worksheet_x000D_
Set xWs = Application.ActiveSheet_x000D_
_x000D_
On Error Resume Next_x000D_
_x000D_
With Me.TempCombo_x000D_
.LinkedCell = vbNullString_x000D_
.Visible = False_x000D_
End With_x000D_
_x000D_
If target.Cells.count > 1 Then_x000D_
Exit Sub_x000D_
End If_x000D_
_x000D_
Dim isect As Range_x000D_
Set isect = Application.Intersect(target, Range(DROPDOWN_RANGE))_x000D_
If isect Is Nothing Then_x000D_
Exit Sub_x000D_
End If_x000D_
_x000D_
With Me.TempCombo_x000D_
.Visible = True_x000D_
.Left = target.Left - 1_x000D_
.Top = target.Top - 1_x000D_
.Width = target.Width + 5_x000D_
.Height = target.Height + 5_x000D_
.LinkedCell = target.Address_x000D_
_x000D_
End With_x000D_
_x000D_
Me.TempCombo.Activate_x000D_
Me.TempCombo.DropDown_x000D_
End Sub_x000D_
_x000D_
Private Sub TempCombo_Change()_x000D_
If Me.TempCombo.Visible = False Then_x000D_
Exit Sub_x000D_
End If_x000D_
_x000D_
Dim currentValue As String_x000D_
currentValue = Range(Me.TempCombo.LinkedCell).Value_x000D_
_x000D_
If Trim(currentValue & vbNullString) = vbNullString Then_x000D_
Me.TempCombo.ListFillRange = "=" & DATA_RANGE_x000D_
Else_x000D_
If Me.TempCombo.ListIndex = -1 Then_x000D_
Dim listCount As Integer_x000D_
listCount = write_matching_items(currentValue)_x000D_
Me.TempCombo.ListFillRange = "=" & HELP_COLUMN & "1:" & HELP_COLUMN & listCount_x000D_
Me.TempCombo.DropDown_x000D_
End If_x000D_
_x000D_
End If_x000D_
End Sub_x000D_
_x000D_
_x000D_
Private Function write_matching_items(currentValue As String) As Integer_x000D_
Dim xWs As Worksheet_x000D_
Set xWs = Application.ActiveSheet_x000D_
_x000D_
Dim cell As Range_x000D_
Dim c As Range_x000D_
Dim firstAddress As Variant_x000D_
Dim count As Integer_x000D_
count = 0_x000D_
xWs.Range(HELP_COLUMN & ":" & HELP_COLUMN).Delete_x000D_
With xWs.Range(DATA_RANGE)_x000D_
Set c = .Find(currentValue, LookIn:=xlValues)_x000D_
If Not c Is Nothing Then_x000D_
firstAddress = c.Address_x000D_
Do_x000D_
Set cell = xWs.Range(HELP_COLUMN & "$" & (count + 1))_x000D_
cell.Value = c.Value_x000D_
count = count + 1_x000D_
_x000D_
Set c = .FindNext(c)_x000D_
If c Is Nothing Then_x000D_
GoTo DoneFinding_x000D_
End If_x000D_
Loop While c.Address <> firstAddress_x000D_
End If_x000D_
DoneFinding:_x000D_
End With_x000D_
_x000D_
write_matching_items = count_x000D_
_x000D_
End Function_x000D_
_x000D_
Private Sub TempCombo_KeyDown( __x000D_
ByVal KeyCode As MSForms.ReturnInteger, __x000D_
ByVal Shift As Integer)_x000D_
_x000D_
Select Case KeyCode_x000D_
Case 9 ' Tab key_x000D_
Application.ActiveCell.Offset(0, 1).Activate_x000D_
Case 13 ' Pause key_x000D_
Application.ActiveCell.Offset(1, 0).Activate_x000D_
End Select_x000D_
End Sub
_x000D_
Notes:
2 - fmMatchEntryNone
. Don't forget to set ComboBox name to TempCombo
ComboBox.addItem
, but it turned out to be hard to repaint list box as user types