Option Explicit
Public grngCurrent As Range
Public Sub ShowForTesting()
' Execute this sub from here or the Immediate Window
' if you want to see the floating textbox.
With ActiveSheet.txtFloat
.Top = 10
.Left = 10
.Width = 50
.Height = 50
.Visible = True
.Text = "This is txtFloat"
End With
End Sub
Option Explicit
Private Sub txtFloat_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Set grngCurrent = ActiveCell
' Move to next cell on Enter and Tab
Select Case KeyCode
Case 9
ActiveCell.Offset(0, 1).Activate
Case 13
ActiveCell.Offset(1, 0).Activate
' The following two Cases are here only for this demo
Case 48 To 57, 8
' Numbers and backspace are OK
Case Else
KeyCode = 0
Beep
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next
grngCurrent.Value = txtFloat.Text
' Set the range where you want the textbox to appear
If Intersect(ActiveCell, Range("A2:F2")) Is Nothing Then
txtFloat.Visible = False
Exit Sub
End If
Set grngCurrent = ActiveCell
Application.EnableEvents = False
Application.ScreenUpdating = False
If Application.CutCopyMode Then
'allows copying and pasting on the worksheet
GoTo errHandler
End If
With txtFloat
.ListFillRange = ""
.LinkedCell = ""
.SpecialEffect = fmSpecialEffectFlat
.Visible = True
.Left = Target.Left + 1
.Top = Target.Top + 1
.Width = Target.Width - 1
.Height = Target.Height - 1
.Text = Target.Value
.Activate
End With
errHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Option Explicit
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' Move to next cell if Tab or Enter are pressed
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 Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ShowAutocomplete Target
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Application.EnableEvents = False
If Application.CutCopyMode Then
'allow copying and pasting on the worksheet
GoTo errHandler
End If
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Module Code
Option Explicit
Public Sub ShowAutocomplete(Target As Range)
Dim strVF As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim strParts() As String
Dim lngIndex As Long
On Error GoTo errHandler
Set ws = ActiveSheet
Set cboTemp = ws.OLEObjects("TempCombo")
With cboTemp
' Clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
If Target.Validation.Type = 3 Then
' The cell contains a data validation list
Application.EnableEvents = False
With cboTemp
' Show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
' Optionally increase the font size
'ActiveSheet.TempCombo.Font.Size = 24
If Left$(Target.Validation.Formula1, 1) <> "=" Then
' The dropdown data is a plain List of values like one,two,three
ActiveSheet.TempCombo.Clear
strParts = Split(Target.Validation.Formula1, ",")
For lngIndex = 0 To UBound(strParts)
ActiveSheet.TempCombo.AddItem strParts(lngIndex)
Next
Else
' The dropdown data comes from a Named Range.
' Get the data validation formula.
strVF = Target.Validation.Formula1
strVF = Right(strVF, Len(strVF) - 1)
.ListFillRange = strVF
End If
.LinkedCell = Target.Address
End With
cboTemp.Activate
' Open the drop down list automatically
ActiveSheet.TempCombo.DropDown
End If
Application.EnableEvents = True
On Error GoTo 0
Exit Sub
errHandler:
Application.EnableEvents = True
' If it's 1004 there's no data validation in the cell
If Err.Number <> 1004 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ShowAutocomplete"
End If
End Sub
Option Explicit
Public gbMaintBeingDone As Boolean
Sub Maintenance()
' This macro is a toggle and it's purpose is to prevent/allow the
' autocomplete combobox from being displayed so that Data
' Validation can be maintained if necessary.
gbMaintBeingDone = Not gbMaintBeingDone
End Sub
Public Sub ShowAutocomplete(Target As Range)
Dim strVF As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim strParts() As String
Dim lngIndex As Long
On Error GoTo errHandler
Set ws = ActiveSheet
If gbMaintBeingDone Then
Exit Sub
End If
Set cboTemp = ws.OLEObjects("TempCombo")
'On Error Resume Next
With cboTemp
' Clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
If Target.Validation.Type = 3 Then
' The cell contains a data validation list
Application.EnableEvents = False
With cboTemp
' Show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
' Optionally increase the font size
'ActiveSheet.TempCombo.Font.Size = 24
If Left$(Target.Validation.Formula1, 1) <> "=" Then
' The dropdown data is a plain List of values like one,two,three
ActiveSheet.TempCombo.Clear
strParts = Split(Target.Validation.Formula1, ",")
For lngIndex = 0 To UBound(strParts)
ActiveSheet.TempCombo.AddItem strParts(lngIndex)
Next
Else
' The dropdown data comes from a Named Range.
' Get the data validation formula.
strVF = Target.Validation.Formula1
strVF = Right(strVF, Len(strVF) - 1)
.ListFillRange = strVF
End If
.LinkedCell = Target.Address
End With
cboTemp.Activate
' Open the drop down list automatically
ActiveSheet.TempCombo.DropDown
End If
Application.EnableEvents = True
On Error GoTo 0
Exit Sub
errHandler:
Application.EnableEvents = True
' If it's 1004 there's no data validation in the cell
If Err.Number <> 1004 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ShowAutocomplete"
End If
End Sub
Sheet Code
Option Explicit
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' Move to next cell if Tab or Enter are pressed
Select Case KeyCode
Case 9 'Tab
ActiveCell.Offset(0, 1).Activate
Case 13 'Enter
ActiveCell.Offset(1, 0).Activate
End Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Application.EnableEvents = False
If Application.CutCopyMode Then
'allow copying and pasting on the worksheet
GoTo errHandler
End If
ShowAutocomplete Target
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
Floating-Textbox.xlsm
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (9)
Commented:
First of all, thank you so much for this functionality. It's incredibly useful.
However, I am having a bizarre issue.
Your code works perfectly for me on my machine across multiple sheets in my workbook.
However, when my supervisor opens the same workbook on her machine and tries to navigate any cell, related or unrelated, via the arrow keys she gets the following error message:
"Error -2147467259 (Method 'ListFillRange' of object '_OLEObject' failed) in procedure ShowAutocomplete"
My first thought was that she didn't have the appropriate references selected on her machine so it didn't know what an _OLEObject was, but after comparison against my own that doesn't seem to be the case.
Commented:
I am using a named range to populate the floating combobox.
I have run into this issue thay may or may not be related to the floating combobox's, but I wonder if anyone would have encountered the same issue :
Bogus validation list appears in cell after a double click and selection change " https://www.experts-exchange.com/questions/28938860/ExcelVBA-Delete-bogus-validation-list-in-cell.html "
I beleive it is an Office 365 bug (XL 2016) because this has not occured to me using XL 2013 and 2010.
Commented:
I am struggling with capturing Range after entering Change, So I could ad my own "Sub search" after box populate the value.
Could you show how to reference to last entered value in a search box via "RANGE" ?
Best Thanks,
Daniel
Commented:
Author
Commented:=OFFSET('Named Ranges'!$A$1,0,0,COUNTA('N
Then no coding changes are needed.
View More