<

The magical floating ActiveX control

Published on
20,460 Points
11,960 Views
10 Endorsements
Last Modified:
Approved
Martin Liss
Over 40 years of programming experience. Expand my "Full Biography" to see links to some articles I've written.
This article describes how to "magically" float an ActiveX control on an Excel worksheet.
Excel is an excellent spreadsheet but one of its problems is the paucity of sheet events available to the programmer. For example you might want to know when the user is in the act of changing a cell's value but you can't normally trap the change until you move off the cell, or you might want to display a data validation list that allows the user to type in a few of the first characters of a value and have the full value auto-completed.  This article describes three scenarios where a floating ActiveX control is used that allows you to do those things and more. A working sample for each of the three is attached.
 

1. Floating Textbox

In the case of the textbox you could add one or more ActiveX textboxes to the sheet but then you have at least two problems:
1) The textbox will most likely look like a textbox. In other words it will stand out and you may not want that, and
2) Since VBA doesn't have the concept of arrays of controls, you need separate code (or common code called from each textbox) for each textbox.

The following solution "floats" a single textbox over any range of cells that you specify, appearing, updating the actual cell's contents, and then disappearing almost like magic. The code originally came from Contextures but what you see here is a highly modified version. Note that this concept is not limited to textboxes. You could use a combobox (see below), calendar control or most any ActiveX control. You will of course have to modify references to 'Text' values, etcetera for those controls that don't have a Text property.

Module Code
 
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

Open in new window


Sheet Code
Place this code in the sheet where you want the floating control to appear and manually add one textbox named txtFloat anywhere on the sheet. If you then click on any cell in the specified range (set in the code following the "Set the range..." comment), the textbox will appear and you can type something into it and move on, or edit/validate the text "live".
 
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

Open in new window


If you want to change any of the textboxes properties then run the ShowForTesting sub from the Immediate Window or go to it and press F5.
 

2. Floating Data Validation Combobox

The following are two flavors of a floating Data Validation combobox. The first is triggered by double clicking a cell that contains Data Validation values and the second is triggered immediately when the user enters a cell that contains data validation.

2A. Double Click Version
Sheet Code
Place this code in the sheet where you have data validation and you want the floating combobox to appear and then manually add one ActiveX combobox named TempCombo anywhere on the sheet. If you then double-click on any cell that has data validation the combobox will appear. When you start typing something into it the selection will be autofilled providing of course that there's an entry that starts with what you typed.
 
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

Open in new window

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

Open in new window


2B. On entry Version
This is similar to the previous example except that in this one the floating combobox appears as soon as a cell with data validation is clicked. As in the previous example you should place an ActiveX combobox named TempCombo on any sheet where you want the code to be in effect.

There's a problem with showing the floating combobox as soon as you enter the cell and that is that if you need to change the data validation for a cell, the combobox gets in the way. If you want to see what I'm talking about, comment out the "If gbMaintBeingDone Then" to "End If" lines in the Module code below and try to access the Data Validation for a cell that already has it. The previously referenced "If/End If" code works around the problem by looking at the value of the Boolean named gbMaintBeingDone and if it is True, the code that shows the combobox is bypassed. The Module code includes a 'Maintenance' macro that you can use to turn the combobox on or off. In my applications I assign that macro to Ctrl+Shift+M and since the macro is a toggle, typing that shortcut turns the boolean on if it's off and off if it's on.
Module Code

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

Open in new window

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

Open in new window

Floating-Textbox.xlsm
Floating-Combo-Double-Click.xls
Floating-Combo-On-entry.xls

If you find that this article has been helpful, please click the “thumb’s up” button below. Doing so lets me know what is valuable for EE members and provides direction for future articles. It also provides me with positive feedback in the form of a few points. Thanks!
10
Comment
Author:Martin Liss
9 Comments

Expert Comment

by:DMurray3
Great code Martin...

Testing the 2B "On Entry Version", if one types in a name that is NOT in the named range list, the entry is -notwithstanding prevailing the data validation- accepted and does not throw the "error".

Could you review the code and/or explain how to get the "error message" shown as expeted?

A second question is, can one replicate the codes (1, 2A & 2B) in different worksheets and further, can one set different cells / fields to use these validation/combo boxes  on multiple worksheets?

Again, many thanks for your contribution.

Kind regards

DMurray3
0
LVL 53

Author Comment

by:Martin Liss
Could you review the code and/or explain how to get the "error message" shown as expeted?
Add code like lines 17 to 32 to the Float Combo sheet which will validate the Bird Breeds list. It's not an ideal solution and if I come up with anything better I'll let you know.
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
    Application.ScreenUpdating = True

    If Application.CutCopyMode Then
        'allow copying and pasting on the worksheet
        GoTo errHandler
    End If
    
    ShowAutocomplete Target
    
    Dim rngFound As Range
    If Range("E2") <> "" Then
        With Sheets("Named Ranges").Range("Birds")
            Set rngFound = .Find(What:=Range("E2").Value, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
            If rngFound Is Nothing Then
                MsgBox Range("E1").Value & " '" & Range("E2") & "' not found. It must be a value in the list"
                Range("E2").Value = ""
            End If
        End With
    End If
    
errHandler:
    Application.EnableEvents = True
    Exit Sub

End Sub

Open in new window

can one replicate the codes (1, 2A & 2B) in different worksheets
Yes
can one set different cells / fields to use these validation/combo boxes  on multiple worksheets?

Yes
0

Expert Comment

by:Josh Mullins
This has worked for me and is almost the perfect implementation of what I need to do.  I am running into one problem.  When I share the workbook so multiple people in my office can use it at the same time the combo boxes no longer populate.  The underlying data validation list is still there and functional but all the features of this code seem to be lost.  Please help me adjust the code or do something that will allow this to function while the workbook is shared.
0
Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

LVL 53

Author Comment

by:Martin Liss
I have no way to test the workbook when It is shared and I can't imagine why it doesn't work when shared so unfortunately you'll need to try and debug it yourself. If you don't know how to do that  (or perhaps even if you do) then take a look a my article on debugging. If you need further help then rather than lengthening this thread, please email me using the address you'll find in my profile.
0

Expert Comment

by:Allyson Bonarrigo
Martin,

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.
0
LVL 1

Expert Comment

by:Sach44
Hi Martin. I have been using " version 2A. Double Click Version."

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.
0

Expert Comment

by:Daniel W
Hi,

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
0

Expert Comment

by:Josh O'Keefe
How would you modify this code if some of my data validation formulas contain the INDIRECT function?
0
LVL 53

Author Comment

by:Martin Liss
How would you modify this code if some of my data validation formulas contain the INDIRECT function?
If your data is a Named Range and the Named Range has Indirect as a part of the formula like this (which is a modification of the current Named Range for Dogs)

=OFFSET('Named Ranges'!$A$1,0,0,COUNTA('Named Ranges'!$A:$A),1)

Then no coding changes are needed.
0

Featured Post

Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Join & Write a Comment

Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month