<

The magical floating ActiveX control

Published on
23,470 Points
13,970 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
Author:Martin Liss
Ask questions about what you read
If you have a question about something within an article, you can receive help directly from the article author. Experts Exchange article authors are available to answer questions and further the discussion.
Get 7 days free