I have a code written in Excel VBA by making use of an Active-X element. But somehow Excel keeps crashing, leaving me frustrated. The element should have the following tasks:
- Looking into a predefined source in this case called "Opleidingen".
- You should be able to type inside the box so you can look in to the 200 variables and receive suggestions.
- Once selected it should transpose to the Cell behind so other cells can pick up the data and use it to come back with their own data.
But somehow it keeps crashing
I re-written the code 4 times, removed cells but with no success ( I am not a VBA guru and my knowledge is limited)
Private Sub ComboBox1_Change()
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("ComboBox1")
With xCombox
.ListFillRange = "Opleiding"
.LinkedCell = "$C$4:$J$4"
.Visible = True
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 = "Opleiding" Then
xArr = Split(xStr, ",")
Me.ComboBox1.List = xArr
End If
.LinkedCell = Target.Address
End With
xCombox.Activate
Me.ComboBox1.DropDown
End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub
Excel crashes once I start typing.
Related
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
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
I am trying to create a VBA that allows autocomplete when typing in a data validation cell. I have obtained code from the following question What VBA event allows to capture click value of ActiveX combobox?.
Problem is that when I use the below code from that question and have it run off my name range, which is a list of 200 paragraphs that it is searching within, it crashes me out of excel immediately and I am not sure why. Is there an issue with the code or is searching within 200 paragraphs in 200 separate cells just not viable with VBA?
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 = [QoE].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
You don't use .DropDown. It crash Excel when ComboBox hide or delete
When I protect my sheet and select the list from a combobox, another combobox shows up at a random place (marked by the red circle in the picture below).
I have not placed any comboboxes there, but it keeps showing, and I need to select an empty cell for that to disappear. Does anybody know how to fix this bug ?
this is my combo box code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2018/9/21
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, ",")
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
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub
How to make suggestions in Excel data validation list while typing. There are constraints in my request:
The list of items should be in another sheet, and must not be above in hidden rows.
Typing a phrase should narrow the list to all the items which contain the phrase.
Search should be case insensitive.
So after typing am we should hypothetically have a suggestion to pick up from Amelia, Camila, Samantha, provided that those girls' names are on the item list.
I have found a good solution here, however it does not filter the items with contains clause but begins with. I sum up the proposed solution here shortly.
We insert a Combo Box (ActiveX Control) to a sheet.
We right click on a sheet name > View code > and paste the VBA code in the sheet VBA editor:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2018/9/21
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, ",")
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
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub
I could not find a way to modify to change the search option from 'begins with' to contains.
The questions about autocomplete or autosuggest in validation list have been asked so far.
Excel data validation with suggestions/autocomplete
Excel 2010: how to use autocomplete in validation list
But neither of them contained answers which would satisfied the constraints I imposed.
Test file for download is here.
Try to add the following event (additionally the the other 2). Every time you enter something the code refreshes the ComboBox list.
Private Sub TempCombo_Change()
With Me.TempCombo
If Not .Visible Then Exit Sub
.Clear 'needs property MatchEntry set to 2 - fmMatchEntryNone
.Visible = False 'to refresh the drop down
.Visible = True
.Activate
Dim xStr As String, xArr As Variant
xStr = TempCombo.TopLeftCell.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
xArr = Split(xStr, Application.International(xlListSeparator))
Dim itm As Variant
For Each itm In xArr
If InStr(1, itm, .Value, vbTextCompare) > 0 Or .Value = "" Then
.AddItem itm
End If
Next itm
.DropDown
End With
End Sub
To overcome your first constraint, maybe you can assign a range to your combo box:
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Dim xArr
Dim i As Range
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("Combotest")
With Sheets("Test_list2")
Set i = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
Combotest.ListFillRange = i.Address
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("Combotest")
With xCombox
.LinkedCell = "F2"
.Visible = True
End With
.
.
.
.
End Sub
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.
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
This line in the TempCombo_Click event solved the problem:
ActiveCell.Value = ThisWorkbook.ActiveSheet.OLEObjects("TempCombo").Object.Value