Auto completion in textbox

kelly mort

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
Hello all
I have a challenge here:
I want my textbox to behave in such a way that when I start to enter data in it, it should look at a range in a worksheet and then suggest words or names as I type the letters.

So say I have a name "Kelly" in that range, when I start to type "K" , it should suggest "Kelly" for me to make my work cooler.


I am stucked. I need bigger brains to pull me out. Thanks
Kelly
 
Sort by date Sort by votes
Okay thanks. Now cool to go.

I believe one day we can modify and improve it
Kelly
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
I just had an idea which I wanna see if you can help implement :

Can we get the code to work such that it searches individual words in the cell instead of all the contents?

Say we have sugar bread and I enter s, then it asks if I am after sugar. Or if I enter b then it asks for bread instead.

So say I have brown bread in a cell then when I key in b, it should first ask for bread then brown before moving to next cell as before. Or anything cool that can scan each word instead of whole cell content.

Thanks
 
Upvote 0
You can trial this. As before, data in Sheet1 "A" and textbox output to "B1" on command click. Active X textbox and command button on sheet1. This is sheet1 code. Dave
Code: 
Option Explicit
Dim Flag As Boolean

Private Sub TextBox1_Change()
If TextBox1.Text = vbNullString Then
Flag = False
End If
If Not Flag Then
Call TextboxFill
End If
End Sub

Private Sub CommandButton1_Click()
Sheets("Sheet1").Range("B" & 1).Value = TextBox1.Text
TextBox1.Text = vbNullString
End Sub

Function Checkit(Inputstr As String) As Boolean
Checkit = False
If UCase(Left(Inputstr, 1)) = Left(TextBox1.Text, 1) Or _
LCase(Left(Inputstr, 1)) = Left(TextBox1.Text, 1) Then
If MsgBox(prompt:="Search word: " & Inputstr, Buttons:=vbYesNo, _
                          Title:="IS THIS YOUR WORD?") = vbYes Then
Checkit = True
End If
End If
End Function
                                  
Sub TextboxFill()
Dim Lastrow As Long, Cnt As Long, I As Integer, Tstr As String
'words/sentences in sheet1 "A"
'outputs individual words of each cell
'fills textbox with whole cell contents
If TextBox1.Text <> vbNullString Then
Lastrow = Sheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
'loop "A"
For Cnt = 1 To Lastrow
Tstr = vbNullString
'loop through each cell. Seperate word(s) with " " ie. Asc 32
For I = 1 To Len(Sheets("Sheet1").Range("A" & Cnt).Value)
If Asc(Mid(Sheets("Sheet1").Range("A" & Cnt).Value, I, 1)) <> 32 Then
Tstr = Tstr & Mid(Sheets("Sheet1").Range("A" & Cnt).Value, I, 1) 'make word
Else
If Checkit(Tstr) Then
If MsgBox(prompt:="Replace textbox contents with: " & Sheets("Sheet1").Range("A" & Cnt).Value, _
                        Buttons:=vbYesNo, Title:="REPLACE TEXTBOX CONTENTS?") = vbYes Then
Flag = True
TextBox1.Text = Sheets("Sheet1").Range("A" & Cnt).Value
Exit Sub
End If
End If
Tstr = vbNullString
End If
Next I
'multiword: last word
If Checkit(Tstr) Then
If MsgBox(prompt:="Replace textbox contents with: " & Sheets("Sheet1").Range("A" & Cnt).Value, _
                        Buttons:=vbYesNo, Title:="REPLACE TEXTBOX CONTENTS?") = vbYes Then
Flag = True
TextBox1.Text = Sheets("Sheet1").Range("A" & Cnt).Value
Exit Sub
End If
End If
Next Cnt
End If
Flag = False
End Sub
 
Upvote 0
Wow!!!!
I can't believe my eye!

I love this script.

However it still place the full content of the cell in the textbox. I want it place just the found word. So when I click yes, just place the word I said yes for in the textbox.

I wish this could be accomplished.

Thanks again
Kelly
 
Upvote 0
Fairly simple code adjustment. Merry X-mas. Dave
Code: 
Option Explicit
Dim Flag As Boolean

Private Sub TextBox1_Change()
If TextBox1.Text = vbNullString Then
Flag = False
End If
If Not Flag Then
Call TextboxFill
End If
End Sub

Private Sub CommandButton1_Click()
Sheets("Sheet1").Range("B" & 1).Value = TextBox1.Text
TextBox1.Text = vbNullString
End Sub

Function Checkit(Inputstr As String) As Boolean
Checkit = False
If UCase(Left(Inputstr, 1)) = Left(TextBox1.Text, 1) Or _
LCase(Left(Inputstr, 1)) = Left(TextBox1.Text, 1) Then
If MsgBox(prompt:="Search word: " & Inputstr, Buttons:=vbYesNo, _
                          Title:="IS THIS YOUR WORD?") = vbYes Then
Checkit = True
End If
End If
End Function
                                  
Sub TextboxFill()
Dim Lastrow As Long, Cnt As Long, I As Integer, Tstr As String
'words/sentences in sheet1 "A"
'outputs individual words of each cell
'fills textbox with whole cell contents
If TextBox1.Text <> vbNullString Then
Lastrow = Sheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
'loop "A"
For Cnt = 1 To Lastrow
Tstr = vbNullString
'loop through each cell. Seperate word(s) with " " ie. Asc 32
For I = 1 To Len(Sheets("Sheet1").Range("A" & Cnt).Value)
If Asc(Mid(Sheets("Sheet1").Range("A" & Cnt).Value, I, 1)) <> 32 Then
Tstr = Tstr & Mid(Sheets("Sheet1").Range("A" & Cnt).Value, I, 1) 'make word
Else
If Checkit(Tstr) Then
'If MsgBox(prompt:="Replace textbox contents with: " & Sheets("Sheet1").Range("A" & Cnt).Value, _
                        Buttons:=vbYesNo, Title:="REPLACE TEXTBOX CONTENTS?") = vbYes Then
Flag = True
TextBox1.Text = Tstr 'Sheets("Sheet1").Range("A" & Cnt).Value
Exit Sub
'End If
End If
Tstr = vbNullString
End If
Next I
'multiword: last word
If Checkit(Tstr) Then
'If MsgBox(prompt:="Replace textbox contents with: " & Sheets("Sheet1").Range("A" & Cnt).Value, _
                        Buttons:=vbYesNo, Title:="REPLACE TEXTBOX CONTENTS?") = vbYes Then
Flag = True
TextBox1.Text = Tstr 'Sheets("Sheet1").Range("A" & Cnt).Value
Exit Sub
'End If
End If
Next Cnt
End If
Flag = False
End Sub
 
Upvote 0
NdNoviceHlp said:
Fairly simple code adjustment. Merry X-mas. Dave
Code: 
Option Explicit
Dim Flag As Boolean

Private Sub TextBox1_Change()
If TextBox1.Text = vbNullString Then
Flag = False
End If
If Not Flag Then
Call TextboxFill
End If
End Sub

Private Sub CommandButton1_Click()
Sheets("Sheet1").Range("B" & 1).Value = TextBox1.Text
TextBox1.Text = vbNullString
End Sub

Function Checkit(Inputstr As String) As Boolean
Checkit = False
If UCase(Left(Inputstr, 1)) = Left(TextBox1.Text, 1) Or _
LCase(Left(Inputstr, 1)) = Left(TextBox1.Text, 1) Then
If MsgBox(prompt:="Search word: " & Inputstr, Buttons:=vbYesNo, _
                          Title:="IS THIS YOUR WORD?") = vbYes Then
Checkit = True
End If
End If
End Function
                                  
Sub TextboxFill()
Dim Lastrow As Long, Cnt As Long, I As Integer, Tstr As String
'words/sentences in sheet1 "A"
'outputs individual words of each cell
'fills textbox with whole cell contents
If TextBox1.Text <> vbNullString Then
Lastrow = Sheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
'loop "A"
For Cnt = 1 To Lastrow
Tstr = vbNullString
'loop through each cell. Seperate word(s) with " " ie. Asc 32
For I = 1 To Len(Sheets("Sheet1").Range("A" & Cnt).Value)
If Asc(Mid(Sheets("Sheet1").Range("A" & Cnt).Value, I, 1)) <> 32 Then
Tstr = Tstr & Mid(Sheets("Sheet1").Range("A" & Cnt).Value, I, 1) 'make word
Else
If Checkit(Tstr) Then
'If MsgBox(prompt:="Replace textbox contents with: " & Sheets("Sheet1").Range("A" & Cnt).Value, _
                        Buttons:=vbYesNo, Title:="REPLACE TEXTBOX CONTENTS?") = vbYes Then
Flag = True
TextBox1.Text = Tstr 'Sheets("Sheet1").Range("A" & Cnt).Value
Exit Sub
'End If
End If
Tstr = vbNullString
End If
Next I
'multiword: last word
If Checkit(Tstr) Then
'If MsgBox(prompt:="Replace textbox contents with: " & Sheets("Sheet1").Range("A" & Cnt).Value, _
                        Buttons:=vbYesNo, Title:="REPLACE TEXTBOX CONTENTS?") = vbYes Then
Flag = True
TextBox1.Text = Tstr 'Sheets("Sheet1").Range("A" & Cnt).Value
Exit Sub
'End If
End If
Next Cnt
End If
Flag = False
End Sub
Click to expand...

Finally we made it happen live!!!
Thanks very much and Merry Xmax
Kelly
 
Upvote 0
One last thing: What if I want it to ask me to replace with full cell content after i have said no to all the individual words in the sentence?
 
Upvote 0
Kelly this will be my final contribution. Happy Holidays! Dave
Code: 
Option Explicit
Dim Flag As Boolean, NoSelect As Boolean

Private Sub TextBox1_Change()
If TextBox1.Text = vbNullString Then
Flag = False
End If
If Not Flag Then
Call TextboxFill
End If
End Sub

Private Sub CommandButton1_Click()
Sheets("Sheet1").Range("B" & 1).Value = TextBox1.Text
TextBox1.Text = vbNullString
End Sub

Function Checkit(Inputstr As String) As Boolean
Checkit = False
If UCase(Left(Inputstr, 1)) = Left(TextBox1.Text, 1) Or _
LCase(Left(Inputstr, 1)) = Left(TextBox1.Text, 1) Then
If MsgBox(prompt:="Search word: " & Inputstr, Buttons:=vbYesNo, _
                          Title:="IS THIS YOUR WORD?") = vbYes Then
Checkit = True
Else
NoSelect = True
End If
End If
End Function
                                  
Sub TextboxFill()
Dim Lastrow As Long, Cnt As Long, I As Integer, Tstr As String
'words/sentences in sheet1 "A"
'outputs individual words of each cell
'fills textbox with whole cell contents
If TextBox1.Text <> vbNullString Then
Lastrow = Sheets("sheet1").Cells(Rows.Count, "A").End(xlUp).Row
'loop "A"
For Cnt = 1 To Lastrow
NoSelect = False
Tstr = vbNullString
'loop through each cell. Seperate word(s) with " " ie. Asc 32
For I = 1 To Len(Sheets("Sheet1").Range("A" & Cnt).Value)
If Asc(Mid(Sheets("Sheet1").Range("A" & Cnt).Value, I, 1)) <> 32 Then
Tstr = Tstr & Mid(Sheets("Sheet1").Range("A" & Cnt).Value, I, 1) 'make word
Else
If Checkit(Tstr) Then
'If MsgBox(prompt:="Replace textbox contents with: " & Sheets("Sheet1").Range("A" & Cnt).Value, _
                        Buttons:=vbYesNo, Title:="REPLACE TEXTBOX CONTENTS?") = vbYes Then
Flag = True
TextBox1.Text = Tstr 'Sheets("Sheet1").Range("A" & Cnt).Value
Exit Sub
'End If
End If
Tstr = vbNullString
End If
Next I
'multiword: last word
If Checkit(Tstr) Then
'If MsgBox(prompt:="Replace textbox contents with: " & Sheets("Sheet1").Range("A" & Cnt).Value, _
                        Buttons:=vbYesNo, Title:="REPLACE TEXTBOX CONTENTS?") = vbYes Then
Flag = True
TextBox1.Text = Tstr 'Sheets("Sheet1").Range("A" & Cnt).Value
Exit Sub
'End If
End If
'offer whole sentence option
If NoSelect = True Then
If MsgBox(prompt:="Replace textbox contents with: " & Sheets("Sheet1").Range("A" & Cnt).Value, _
                        Buttons:=vbYesNo, Title:="REPLACE TEXTBOX CONTENTS?") = vbYes Then
Flag = True
TextBox1.Text = Sheets("Sheet1").Range("A" & Cnt).Value
Exit Sub
End If
End If
Next Cnt
End If
Flag = False
End Sub
 
Upvote 0
Thanks for the quick and great work!!!
Surely this is the final .

I really appreciate it.

Enjoy this festive season
Kelly.


Ps:
I now have alot of work to do as I will be studying these scripts daily to get them nailed down.

Thanks again
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
VBA to populate a textbox with a range sum
Replies
3
Views
207
EssKayKay
E
M
  • Solved
Auto increment by 1 when rename excel any tab if name exist
Replies
1
Views
229
jkpieterse
jkpieterse
J
  • Solved
Excel VBA Form Add data to a specific range
Replies
2
Views
262
JJCam
J
D
  • Question Question
Formula "INDIRECT" does not work
Replies
6
Views
325
deri_b
D
J
  • Question Question
Group last name based on range in alphabet
Replies
2
Views
206
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,825
Messages
6,181,191
Members
453,021
Latest member
pingpong7117

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top