Is there a way to refresh a combobox?
I have the following VBA code. The dropdown is populated, until the If statement where the list is cleared and populated with the matched items.
At this point, the dropdown list only shows a single item with a scroll bar. But If I close the pulldown and reopen, it's fully populated correctly.
Private Sub ComboBox_SiteName_Change()
ComboBox_SiteName.DropDown
Dim v As Variant, i As Long
With Me.ComboBox_SiteName
.Value = UCase(.Value)
If .Value <> "" And .ListIndex = -1 Then
v = Worksheets("Address").Range("Table5[[#All],[SITE NAME]]").Value
.Clear ' Clear all items
' Repopulate with matched items
For i = LBound(v, 1) To UBound(v, 1)
If LCase(v(i, 1)) Like "*" & LCase(.Value) & "*" Then
.AddItem v(i, 1)
End If
Next i
Else
' Repopulate with all items
.List = Worksheets("Address").Range("Table5[[#All],[SITE NAME]]").Value
End If
End With
End Sub
The ComboBox_Change function gets called as the user types in the combo box.. the dropdown box turns from a list into a single line with Up/Down arrows after the Clear and Repopulate matched items..
but if I close the dropdown portion and reopen it lists all the items without Up/Down arrows.
The .ListRows value = 8 by the way.
I would like a way for the dropdown potion to either close and reopen.. or a VBA function to refresh the dropdown portion, Without external buttons or controls Please
Getting the list to ONLY show values that matched the text typed by the user so far, was a nightmare. Below is what I wrote which works (but took me a while!)
Note that the MacthEntry Property of the combo box MUST be set to "2 - frmMatchEntryNone" for the code to work. (Other values cause the combo box .value property store the text of the first value that matches what the user typed, and the code relies on it storing what they typed.)
Also note, the trick to get around the behaviour you observed, ie the combo boxes list of values not being sized correctly, was to use the code lines:
LastActiveCell.Activate
ComboBox_SiteName.Activate
Also, the code will pick up any items on the list that have the letters typed by the user ANYWHERE in their text.
Anyway, here's my code:
Private Sub ComboBox_SiteName_GotFocus()
' When it first gets the focus ALWAYS refresh the list
' taking into acocunt what has been typed so far by the user
RePopulateList FilterString:=Me.ComboBox_SiteName.Value
Me.ComboBox_SiteName.DropDown
End Sub
' #4 Private Sub ComboBox_SiteName_Change()
Private Sub ComboBox_SiteName_Enter()
Dim LastActiveCell As Range
On Error GoTo err_Handler
Set LastActiveCell = ActiveCell
Application.ScreenUpdating = False
With Me.ComboBox_SiteName
If .Value = "" Then
' Used cleared the combo
' Repopulate will all values
RePopulateList
.DropDown
Else
' #4 reducdant
' LastActiveCell.Select
' .Activate
' ===========================================
' #4 new code
' CheckBox1 is another control on the form
' which can receive the focus and loose it without event firing
CheckBox1.SetFocus
' This will trigger the GotFocus event handler
' which will do a refresnh of the list
.SetFocus
' ===========================================
End If
End With
Application.ScreenUpdating = True
Exit Sub
err_Handler:
Application.ScreenUpdating = True
Err.Raise Err.Number, "", Err.Description
Exit Sub
Resume
End Sub
Private Sub RePopulateList(Optional FilterString As String = "")
Dim i As Long
Dim ValidValues() As Variant
' #2 range now refers to just the data cells
ValidValues = Worksheets("Address").Range("Table5[SITE NAME]").Value
With Me.ComboBox_SiteName
If FilterString = "" Then
' All all values
.List = ValidValues
Else
' #2: .List cannot be set to have no items.
' so remove all but one
.List = Array("Dummy Value")
' Only add values that match the FilterString parameter
For i = LBound(ValidValues, 1) To UBound(ValidValues, 1)
If LCase(ValidValues(i, 1)) Like "*" & LCase(FilterString) & "*" Then
.AddItem ValidValues(i, 1)
End If
Next i
' #2 add this line to remove the dummy item
.RemoveItem (0)
End If
End With
End Sub
Private Sub ComboBox_SiteName_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Application.ScreenUpdating = False
End Sub
======================================================================
You could: Replace all your code with this which should give acceptable functionality (as long a the data source is in alpha order), and it's easy! However, it doesn't quite do what you wanted.
Private Sub ComboBox_SiteName_GotFocus()
With Me.ComboBox_SiteName
.List = Worksheets("Address").Range("Table5[[#All],[SITE NAME]]").Value
End With
ComboBox_SiteName.DropDown
End Sub
Combo boxes can be set up to "filter as the user types" - so long as the data is in alphabetical order.
======================================================================
Note that in your code the following two lines cause the ComboBox_SiteName_Change event to start again. I suspect you need to add break points and debug you code more.
.Value = UCase(.Value)
.Clear ' Clear all items
Anyway, I hope this is job done.
this will be my first bounty if I get it, so please let me know if you need any more help. (I think it may be worth more than 50 points)
Harvey
================================================
PART 2:
To answer you comment issues:
(See the #2 tag in my code above)
To refer to a table column's data, excluding the header use:
=Table5[SITE NAME]
(This will be autogenerated when entering a formula if you click and drag over the data cells in a column).
The code has been altered accordlingly.
I used excel 2013 and 2010 and found that the .Activate event works in both.
See #3 for a minor change.
Please recopy all the code.
note that I introduced code to try and stop flickering using Application.ScreenUpdating, but it didn;t have any effect - I don't know why. I've left the code in so you can do further experiments should you need to.
NOTE the new procedure ComboBox_SiteName_KeyDown
================================================
PART 3:
To answer you comment issues:
It's a combo on a form ! - so make the change tagged with #4 above.
Harvey
Solved!
https://trumpexcel.com/excel-drop-down-list-with-search-suggestions/
You can do what is in the link with some modifications:
"ListFillRange" in combobox properties should be the last column (the one that is changing). If it is a userform the range will go under "RowSource".
And add this code:
Private Sub ComboBox1_Change()
Sheets("Where the data is").Range("B3") = Me.ComboBox1.Value
End Sub
Try changing the command from Change to DropButtonClick
This refreshes the list on a click of the drop down
Related
I have add a ListBox from Active X Controls in my Excel File and made it a multi select box with checkboxes.
I have also added a selection change event in the VB script against this list box.
Sub lstMultiSelectBox_Change()
If blnCheck = False Then
CheckAll
End If
End Sub
Now what I am struggling to find is that which item was last checked. With this information I want to implement Select All and Un Select All feature in this list box.
In order to make ListBox1_Change event returning the last selected list box value, you can use the solution. It can detect the selected value, independent of its position in the list:
Create a Private variable on top of the sheet module where the list box exists (in the declarations area):
Private colS As New Collection
Then copy the next adapted event code:
Private Sub ListBox1_Change()
Dim i As Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
If colS.Count = 0 Then
colS.Add ListBox1.List(i), ListBox1.List(i)
Else
If Not itExists(colS, ListBox1.List(i)) Then
colS.Add ListBox1.List(i), ListBox1.List(i)
End If
End If
Else
If itExists(colS, ListBox1.List(i)) Then
colS.Remove ListBox1.List(i): Exit Sub
End If
End If
Next i
If colS.Count > 0 Then MsgBox colS(colS.Count)
End Sub
If you want it triggering only if the selected value is "Select All", then replace the last event code line with something like:
If colS.Count > 0 Then
If colS(colS.Count) = "Select All" then
'do whatever you need in such a case
'but, if you try selecting all of lines, in order to avoid the event
'being triggered again, you should use 'Application.EnableEvents = False`, before selecting and 'Application.EnableEvents = True` after
End If
End If
The simplest solution should be the one suggested in the first comment:
If Listbox1.Selected(1) = True Then
'do whatever you need
End If
But, in order to make it working as it should, the line "Select All" should be the second of the list...
I have 2 Comboboxes in a form in Excel VBA. Both are correctly named (pricing and costReport) and both get populated with the total list of open Workbooks. Also both get preselected correctly, looking for the existence of specific strings in their values. So when I hit the Submit button, I want to check each Combobox Value and what happens is very strange.
Depending on the order of each function (UserForm_Initialize and button_Click), the results vary. Check the comments to see the detail.
Private Sub UserForm_Initialize()
'populate each Combobox with the list of open Workbooks
For Each book In Workbooks
pricing.AddItem (book.Name)
costReport.AddItem (book.Name)
Next
'preselect the Value of each, depending on the presence of a specific word
'both Comboboxes end up correctly selected
For Each book In Workbooks
If InStr(1, book.Name, "pricing", 1) > 0 Then
pricing.Value = book.Name
End If
If InStr(1, book.Name, "cost", 1) > 0 Then
costReport.Value = book.Name
End If
Next
End Sub
Private Sub button_Click()
Dim getPricing As String
getPricing = "-" & Me.pricing.Value & "-"
Dim getCostReport As String
getCostReport = "-" & Me.costReport.Value & "-"
Debug.Print getPricing
Debug.Print getCostReport
'if button_Click() is put before UserForm_Initialize()
' getPricing prints "-correct text-"
' getCostReport prints "--"
'but if button_Click() is put after UserForm_Initialize()
' getPricing prints "--"
' getCostReport prints "-correct text-"
End Sub
The strangest thing of all, is that if I manually select other Values (or the same ones) with my mouse cursor while executing the form, then both Values are stored correctly. Therefore I thought it could be a listener or timing issue. I tried changing the Initialize event to Activate, and I've also tried using Wait for a few seconds, none of which works.
You can see a reprex here
I have a User Form in Excel in which questions are indexed in a Listbox control. Clicking on an item in the Listbox calls a Change event which populates other controls' values according to which item has been selected.
The user may change values within the text boxes. Upon changing them, a "Saved" flag gets set to False for that question. The user may then save the question into memory; or navigate away from the question.
If the user navigates away without saving (by means of clicking a different item in the Listbox), I want to present them with a warning - giving the option to either abandon their unsaved changes; or to remain with the current selection, and revert the Listbox selection which they just clicked.
If "Abandon changes" is selected, it works fine. However it runs into trouble when I try to revert the Listbox selection. I use an "EventsOn" Boolean to handle when the Change procedure should proceed, to avoid it calling itself. This seems to work, at the correct point in the code. However after EventsOn is reinstated, and after Exit Sub, it seems that the Change event is called again.
I do not know why the event is firing again. This results in the user being presented with the option a second time.
A lot of the following code has been stripped out because it relates to details of other form controls; loading/saving data from a database; and handling classes and dictionaries. However I have retained the relevant logic of the form controls:
Option Explicit
Dim NumberOfQuestions As Long
Dim EventsOn As Boolean
Dim SelectedListIndex As Long, CurrentQuestion As Long, QuestionSaved As Variant
Private Sub UserForm_Initialize()
' Stripped out lots of code here. Basically opens a recordset and loads values
ReDim QuestionSaved(1 To NumberOfQuestions) As Boolean
'
For X = 1 To NumberOfQuestions
lbox_QuestionList.AddItem "Question " & X ' Populate the listbox with items
QuestionSaved(X) = True ' Flag the initial state as saved, for each question
If Not X = rst.RecordCount Then rst.MoveNext
Next X
'
' Select the first question by default. Note that the Listbox ListIndex starts at 0, whereas the questions start at 1
SelectedListIndex = 0
CurrentQuestion = 1
EventsOn = True
lbox_QuestionList.ListIndex = SelectedListIndex
End Sub
Private Sub lbox_QuestionList_Change()
' Ensure this event does NOT keep firing in a loop, when changed programmatically
If Not EventsOn Then Exit Sub
'
If Not QuestionSaved(CurrentQuestion) Then
If MsgBox(Prompt:="Abandon changes to current question?", Title:="Current question not saved", Buttons:=vbYesNo + vbDefaultButton2) = vbYes Then
' Abandon changes = Yes
' Mark as saved
QuestionSaved(CurrentQuestion) = True
' Then proceed to change as normal
' (If the user comes back to this question, it will be re-loaded from memory in its original form)
' This works okay
Else
' Abandon changes = No
EventsOn = False ' So this sub is not called again
' REVERT the ListBox selection. Do this by recalling the current question number, and applying it to the ListIndex
SelectedListIndex = CurrentQuestion - 1 ' Remember that the index will be minus 1, due to indexing starting at 0
lbox_QuestionList.ListIndex = SelectedListIndex
EventsOn = True
Exit Sub ' This should be the end of it. But somehow, it's not...
End If
End If
' Proceed with loading a new question according to the new selected ListIndex
SelectedListIndex = lbox_QuestionList.ListIndex ' Recognise the current selection
' ListIndex starts at zero, so we need to add 1
CurrentQuestion = SelectedListIndex + 1
ShowQuestion CurrentQuestion
End Sub
Private Sub ShowQuestion(QuestionNumber As Long)
' Stripped out code for brevity. Basically loads details from a dictionary of classes, and populates into textboxes
End Sub
Private Sub cb_Save_Click()
' Stipped out code. Takes values of current text boxes and saves them into a class in a dictionary
' Mark the current question as saved:
QuestionSaved(CurrentQuestion) = True
End Sub
''''''''''' Event handlers ''''''''''''''
Private Sub tb_Question_Change()
DoChange
End Sub
' Several other form controls have similar events: all calling "DoChange" as below
Private Sub DoChange()
If Not EventsOn Then Exit Sub
QuestionSaved(CurrentQuestion) = False ' Flag the current question as NOT saved, if any changes are made to form values
End Sub
Naturally, I have searched for this problem - but there are no answers so far which have assisted me:
Listbox events firing strangely - relates to C# and not VBA
listbox selected item changed event fired two times - relates to C# and not VBA
vba listbox event fires twice - suggests that a SetFocus method of the Listbox could solve the issue. However I have tried this, and the problem remains
The logic of my code seems sound. The mystery is why the Change event is being called a second time, even after Exit Sub.
(curses to OP for getting this problem in my brain!)
In my testing, I used the following UserForm:
The code below uses the ListBox1_AfterUpdate event, and I believe it may work for you.
Option Explicit
Private Const TOTAL_QUESTIONS As Long = 3
Private qSaved As Variant
Private selectedDuringTextboxChange As Long
Private eventsInProgress As Long
Private Sub ListBox1_AfterUpdate()
Debug.Print "listbox clicked, item " & (ListItemSelected() + 1) & " selected"
If eventsInProgress > 0 Then
Debug.Print " ... event in progress, exiting"
eventsInProgress = eventsInProgress - 1
Exit Sub
End If
If Not qSaved(selectedDuringTextboxChange) Then
Dim answer As VbMsgBoxResult
answer = MsgBox("Abandon changes?", vbYesNo + vbDefaultButton2)
If answer = vbYes Then
Debug.Print "yes, abandon the changes"
qSaved(selectedDuringTextboxChange) = True
Else
Debug.Print "nope, keep the changes"
'--- return to the previously selected list item
eventsInProgress = eventsInProgress + 1
UnselectAll
ListBox1.Selected(selectedDuringTextboxChange - 1) = True
ListBox1.ListIndex = selectedDuringTextboxChange - 1
End If
End If
End Sub
Private Sub QuitButton_Click()
Me.Hide
End Sub
Private Sub SaveButton_Click()
qSaved(ListBox1.ListIndex + 1) = True
End Sub
Private Sub TextBox1_Change()
selectedDuringTextboxChange = ListBox1.ListIndex + 1
qSaved(selectedDuringTextboxChange) = False
Debug.Print "changed text for question " & selectedDuringTextboxChange
End Sub
Private Sub UserForm_Initialize()
ReDim qSaved(1 To TOTAL_QUESTIONS)
selectedDuringTextboxChange = 1
With ListBox1
Dim i As Long
For i = 1 To TOTAL_QUESTIONS
.AddItem "Question " & i
qSaved(i) = True
Next i
.Selected(0) = True
End With
eventsInProgress = False
End Sub
Private Sub UnselectAll()
eventsInProgress = eventsInProgress + 1
With ListBox1
Dim i As Long
For i = 0 To .ListCount - 1
.Selected(i) = False
Next i
End With
eventsInProgress = eventsInProgress - 1
End Sub
Private Function ListItemSelected() As Long
ListItemSelected = -1
With ListBox1
Dim i As Long
For i = 0 To .ListCount - 1
If .Selected(i) Then
ListItemSelected = i
End If
Next i
End With
End Function
Private Sub WhichListItem_Click()
With ListBox1
Dim i As Long
For i = 0 To .ListCount - 1
Debug.Print "listbox item(" & i & ") = " & .Selected(i)
Next i
End With
Debug.Print "eventsInProgress = " & eventsInProgress
End Sub
After looking into it for awhile, it appears that having the listbox set its own listindex from within its own change event (effectively recursively calling it) causes some weird backend issues. Fortunately, it's easy enough to deal with by migrating that bit out to its own function. After some experimenting, the best way to do it would be to create a function that clears and repopulates the listbox, so create this function in your UserForm code:
Private Function PopulateListbox(Optional ByVal arg_lSelected As Long = -1)
Me.lbox_QuestionList.Clear
Dim X As Long '
For X = 1 To NumberofQuestions
lbox_QuestionList.AddItem "Question " & X ' Populate the listbox with items
QuestionSaved(X) = True ' Flag the initial state as saved, for each question
'If Not X = rst.RecordCount Then rst.MoveNext
Next X
Me.lbox_QuestionList.ListIndex = arg_lSelected
End Function
Now adjust your Initialize event to look like this (note that you need to define NumberofQuestions here, and then call the new function at the end to populate the listbox and select the first entry):
Private Sub UserForm_Initialize()
' Stripped out lots of code here. Basically opens a recordset and loads values
NumberofQuestions = 3 'This is where NumberofQuestions gets defined
ReDim QuestionSaved(1 To NumberofQuestions)
ReDim aAnswers(1 To NumberofQuestions)
'
' Select the first question by default. Note that the Listbox ListIndex starts at 0, whereas the questions start at 1
SelectedListIndex = 0
CurrentQuestion = 1
EventsOn = True
PopulateListbox SelectedListIndex 'Call the new function and set the 1st selection
End Sub
Lastly, update your listbox_change event to look like this (basically just outsourcing the setting of the listbox entry to the new function):
Private Sub lbox_QuestionList_Change()
' Ensure this event does NOT keep firing in a loop, when changed programmatically
If Not EventsOn Then Exit Sub
'
If Not QuestionSaved(CurrentQuestion) Or aAnswers(CurrentQuestion) <> Me.tb_Question.Text Then 'I added the second condition for testing purposes, may not be necessary in your full code
If MsgBox(Prompt:="Abandon changes to current question?", Title:="Current question not saved", Buttons:=vbYesNo + vbDefaultButton2) = vbYes Then
' Abandon changes = Yes
' Mark as saved
QuestionSaved(CurrentQuestion) = True
' Then proceed to change as normal
' (If the user comes back to this question, it will be re-loaded from memory in its original form)
' This works okay
Else
' Abandon changes = No
EventsOn = False ' So this sub is not called again
' REVERT the ListBox selection. Do this by recalling the current question number, and applying it to the ListIndex
SelectedListIndex = CurrentQuestion - 1 ' Remember that the index will be minus 1, due to indexing starting at 0
PopulateListbox SelectedListIndex 'Call your new function here
EventsOn = True
Exit Sub ' This should be the end of it. But somehow, it's not...
End If
End If
' Proceed with loading a new question according to the new selected ListIndex
SelectedListIndex = lbox_QuestionList.ListIndex ' Recognise the current selection
' ListIndex starts at zero, so we need to add 1
CurrentQuestion = SelectedListIndex + 1
ShowQuestion CurrentQuestion
End Sub
I had a problem with a Private Sub ListBox_Click() running twice.
When I cleared the ControlSource in the list box properties it fixed the problem. I had to add a line of code to specifically write the value from the listbox to the cell in the worksheet. At first the cell would not display the data so I set the range name to another cell and that was OK. So, I then dragged and dropped the new cell into the original location.
I don't understand where the problem originated, but the fix worked.
I had a similar unexpected issue, so maybe someone will find this result helpful.
Within a multi-selection-enabled Listbox_Change event, I checked the value of the currently-selected item to see whether it had been checked or unchecked.
Private Sub lstBox_Change()
With lstBox
If .Selected(.ListIndex) Then
' Call Method A.
Else
' Call Method B.
End If
End With
End Sub
When the list was checked, it would properly detect the selection and call A--but then, when stepping through the code and reaching the Change event's End Sub, the checkbox would automatically become unselected, and the Change event would fire again. Note that I wasn't setting any value in the ListBox itself; I was only checking to see whether the current item was checked or unchecked. But, somehow, that triggered it to unselect itself. (Also, this only seemed to happen on the first call to the Change event. Thereafter it behaved normally.)
I tried some of the other fixes, but BeforeUpdate and AfterUpdate never seemed to fire at all. The problem went away when I moved the selection test outside of the If statement and put the result into a Boolean instead:
Private Sub lstBox_Change()
With lstBox
BooleanResult = (.Selected(.ListIndex) = True)
If BooleanResult Then
' Call Method A.
Else
' Call Method B.
End If
End With
End Sub
After that, the ListBox consistently behaved as expected.
I'm trying to create a simple worksheet-based form that will pull data from the selections into another sheet on the Excel workbook. This is my first time messing with Visual Basic and ActiveX controls and I don't have much programming experience, but with a lot of Googling I've managed to muddle through some so far.
The part in question: I have a couple of multiselect boxes that, with the click of a button, push the data into the spreadsheet, using this code:
Private Sub CommandButton1_Click()
Dim I As Long
Range("A10").Select
Range(Selection, Selection.End(xlToRight)).ClearContents
With Me.ListBox1
For I = 0 To .ListCount - 1
If .Selected(I) Then
Flg= True
txt = txt & "," & .List(I)
End If
Next
End With
If Flg Then
With Sheets("Sheet1")
.Range("A10").Value = Mid$(txt, 2)
End With
End If
txt=""
'Repeat for each listbox'
End Sub
As long as the user has selected at least one item in each listbox, this works fine to pull the data, and from there I can do what I need. But I don't want to require the user to click in each box (that is, I suppose I could force them to click a null selection if they don't want to select something in that box, but it would be easier to just have them not select anything at all). But (understandably) when nothing is selected in a given box, the code I pasted above returns run-time error 1004: No data was selected to parse.
How can I permit the user to make no selection in a box, and have the code just leave the associated cell blank when the data are retrieved?
Wow, after a couple of days of looking I finally found it. This is the code that worked for me:
Private Sub ListBox1_LostFocus()
Dim listItems As String, i As Long
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then listItems = listItems & .List(i) & ", "
Next i
End With
If Len(listItems) > 0 Then
Range("A2") = Left(listItems, Len(listItems) - 2)
Else
Range("A2") = ""
End If
End Sub
And it came from this page: https://www.mrexcel.com/forum/excel-questions/584437-write-selections-excel-listbox-cell.html ...thanks to 'Marcelo Branco' for providing that answer 7 years ago!
EDIT - This really answers a separate question that I had (about retrieving the data automatically), but it seems to also work for the big question here, since when nothing is selected, the target cell is blank.
I am relatively new to VBA and I am trying to solve a problem working with a userform in Excel 2010.
I am writing a pseudo spell checker that validates words against a list. The unknown word is presented in a text box and the list of allowed words is in a combo box below. I would like the combo box to present a 'suggestion' based on the unknown word. i.e. the unknown word is "Excavation" and one of the allowed words in the combo box is "Excavate". I would like the combo box to suggest the term "Excavate". My problem is that autocomplete doesn't offer a suggestion because the unknown word is longer than the allowed word.
My thought on solving the problem is to do the following:
- Parse the unknown word into a character array.
- Add the characters one at a time to the combo box text property and allow autocomplete to run.
- As soon as autocomplete stops working, remove one character and insert the word that autocomplete suggests.
My problem is I cannot find anything to tell me once auto complete has stopped working.
Any thoughts, suggestions, or alternate approaches welcome.
Thanks in advance,
Will
You may want to change 2 properties for the ComboBox to force an entry from a list is selected:
MatchEntry --> 1 - fmMatchEntryComplete
MatchRequired --> True
So when a user try to select a word outside of the list, they get a "Invalid property value.":
This code assumes a TextBox and ComboBox as you described, still with their default names. In addition there's a button, which when pressed prompts you for a word. This word is then pasted into the textbox, which I think duplicates the behavior you're coding for:
Private Sub UserForm_Activate()
With Me.ComboBox1
.AddItem "bat"
.AddItem "battleship"
.AddItem "battle"
.AddItem "batty"
.AddItem "bathhouse"
End With
End Sub
Private Sub CommandButton1_Click()
Me.TextBox1 = Application.InputBox("Word", , , , , , , 2)
End Sub
Private Sub TextBox1_Change()
Dim WordToMatch As String
Dim AvailableWords() As String
Dim i As Long
Dim MatchedWordPosition As Long
Dim LongestWordLength As Long
With Me.ComboBox1
.ListIndex = -1
WordToMatch = Me.TextBox1.Text
ReDim AvailableWords(0 To .ListCount - 1)
For i = LBound(AvailableWords) To UBound(AvailableWords)
AvailableWords(i) = .List(i)
LongestWordLength = WorksheetFunction.Max(Len(.List(i)), LongestWordLength)
Next i
For i = 0 To Len(WordToMatch) - 1
On Error Resume Next
MatchedWordPosition = WorksheetFunction.Match(WordToMatch & WorksheetFunction.Rept("?", (LongestWordLength - Len(WordToMatch)) - i), AvailableWords(), 0)
If MatchedWordPosition > 0 Then
Exit For
End If
Next i
If MatchedWordPosition > 0 Then
.ListIndex = MatchedWordPosition - 1
End If
End With
End Sub
I imagine there are a few ways to skin this cat, but this is my best effort.