Making a Searchable Combobox to Replace Data Validation with No Helper Columns - excel

Question

I'm building a spreadsheet for staffing purposes. The workbook that contains it is made up of 2 sheets. The one in question and a separate one for validation lists for various different situtations. Currently none are dependant on each other. The two lists in question are for Team Members and Roles. They are both in separate structured tables and both are contained in dual named ranges. The first references the table column directly and the second references the first to make it an indirect reference to the table.
My goal is to make the combobox searchable without the use of helper columns. I had that and it worked somewhat, but because the formulas were volatile it broke easily. The first part of my code I found and adapted to suit my needs. But basically, it makes the combobox appear in any cell that has data validation set for dropdowns and sets some parameters for it. I turned off the validation dropdown to accomodate the combobox and it works nicely. The part I can't seem to get is the "searchable part". In the TempCombo_Keydown sub I try to put the named ranges in arrays and loop through them to make the combobox return only names containing the string of characters typed no matter where in the name they are. To make a long story short I've run into a myriad of errors such as Type Mismatch, Permission Denied, and a few others and every time I think I've fix one another pops up... *Note - All tables are structured tables
I'm by no means a vba guru and I could really use a hand. I've uploaded marked up screenshots because I guess I can't upload the file. If someone would be willing to take a look and help me understand where I'm going wrong and how to get it to work I'd very much appreciate it. Learned a lot doing this so far, but I've hit a wall. Below is the code pertaining to the combobox and I've marked the line where the most recent error is (Permission Denied). I'm happy to answer any questions, thank you!
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 = vbNull
.LinkedCell = vbNull
.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
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 = ""
.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_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Dim arrIn() As Variant
Dim arrOut() As Variant
Dim i As Long
Dim j As Long
If Not Application.Intersect(ActiveCell, Range("Name")) Is Nothing Then
arrIn = Sheets("Validation Lists").Range("Tm_11").Value
Else
If Not Intersect(ActiveCell, Range("Position")) Is Nothing Then
arrIn = Sheets("Validation Lists").Range("Role_11").Value
End If
End If
ReDim arrOut(1 To UBound(arrIn), 1 To 1)
For i = 1 To UBound(arrIn)
If arrIn(i, 1) Like "*" & TempCombo.Text & "*" Then
j = j + 1
arrOut(j, 1) = arrIn(i, 1)
End If
Next
TempCombo.List = arrOut 'Location of current "Permission Denied" error
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
Private Sub TempCombo_LostFocus()
Application.ScreenUpdating = False
With Me.TempCombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = vbNull
.LinkedCell = vbNull
.Visible = False
.Value = vbNull
End With
Application.ScreenUpdating = True
End Sub

Answer 1

For anyone interested in knowing... Below is my final code. I was able to achieve what I was looking to do and some. If anyone has any comments or ideas for a better way to achieve the same thing I'd certainly be interested in hearing about it. That being said what I have is working nicely so far!
I did end up with something a little different than what #FaneDuru and I were discussing above. In researching how to improve on what I already had I came across another similar thread on a different site so I modified that code to my situation, and it works just a little more smoothly.
Link mentioned above:
https://www.mrexcel.com/board/threads/how-to-use-a-combobox-with-autocomplete-and-search-as-you-type.1098277/
Option Explicit
Private IsArrow As Boolean
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 = vbNull
.LinkedCell = vbNull
.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
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
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 = ""
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.TempCombo.DropDown
End If
errHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
End Sub
Private Sub TempCombo_Change()
Dim i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Not IsArrow Then
With Me.TempCombo
If Not Application.Intersect(ActiveCell, Range("Name")) Is Nothing Then
Me.TempCombo.List = Worksheets("Validation Lists").Range("TM_11").Value
Else
If Not Intersect(ActiveCell, Range("Position")) Is Nothing Then
Me.TempCombo.List = Worksheets("Validation Lists").Range("Role_11").Value
End If
End If
.ListRows = Application.WorksheetFunction.Min(6, .ListCount)
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
End With
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
If KeyCode = vbKeyReturn Then
If Not Application.Intersect(ActiveCell, Range("Name")) Is Nothing Then
Me.TempCombo.List = Worksheets("Validation Lists").Range("TM_11").Value
Else
If Not Intersect(ActiveCell, Range("Position")) Is Nothing Then
Me.TempCombo.List = Worksheets("Validation Lists").Range("Role_11").Value
End If
End If
End If
Select Case KeyCode
Case 13 'Enter
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub TempCombo_LostFocus()
Application.ScreenUpdating = False
With Me.TempCombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = vbNull
.LinkedCell = vbNull
.Visible = False
.Value = vbNull
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub