I'm trying to make ActiveX (MSForms) ComboBox controls on a worksheet
be keyboard-driven. I've got it doing what I want except for one
strange behavior.


The behavior I want is:

-- When a user lands on a given cell, whether by clicking there,
tabbing, or pressing enter, the ComboBox for that column:
-- Moves to that cell.
-- Becomes visible.
-- Displays (drops down) its list.
-- If there was already an entry in that cell, display it, and
select it, in the Combobox's edit box.
-- If that entry matches a list item in the list, select that
item in the list.
-- If the user starts typing (in the ComboBox's edit box),
autocomplete it based on items in the list.
-- If the user does anything to the ComboBox with the mouse, allow
the normal, expected mouse-driven behavior.


That's all working fine, EXCEPT:

If I tab from one cell to another (or press enter from one cell to
another, if Excel's option to move after enter is turned on), the
dropdown only displays every other cell.

On those cells where the dropdown does NOT appear, if I press Alt
+Enter to try to drop down the list, I get a partial list (not all of
the list items are shown), in a smaller, different font -- or no list
at all, in a very small empty dropdown. I haven't found any keyboard
action that gets the list back to normal on those cells. However, if I
click the mouse in the edit box (and press Ctrl+a to select the
contents if there was an entry in the cell), then I'm back to the
correct behavior.

I put debug.prints on all the ComboBox's events I'm using, and found
that on the good ones, a final Enter key is sent to the control (not
by me explicitly). However, if I manually press enter on the bad
cells, it doesn't help.

I tried putting DoEvents in key spots in case some event wasn't
getting fired due the control not being ready. That didn't help.

I tried capturing keyboard messages with Visual Studio Spy++, but Spy+
+ doesn't see the ComboBox control on the worksheet. So I tried
capturing keyboard messages to the worksheet's window, but although I
do see the messages, they look the same for both the good cells and
the bad ones.



All I can think of at this point is to check for that extra Enter key
that happens on the good cells, and if it doesn't appear after a given
interval, to send a mouseclick (via postmessage or whatever) and then
send a Ctrl+a (because that's all I've found that gets the dropdown
back to correct behavior interactively). But getting the mouseclick
coordinates might be a problem since Spy++ doesn't see the ActiveX
ComboBox control. I'd probably have to figure out mouseclick
coordinates based on the cell location.

Is there a better to get this working correctly?



FWIW, here's my code:

(If you put four ActiveX ComboBox controls on the sheet, and name them
cboColor, cboPattern, cboShape, and cboBigList, and then make lists
for them on another sheet, and name (defined names) those lists as
"dropdown_color", "dropdown_pattern", "dropdown_shape", and
"dropdown_bigllist", then this code should run without modification)

The ComboBox controls will appear in columns A - D when any single
cell in any of those columns is selected.


'this goes in the Workbook module's Workbook_Open event:

shDropdownTest.cboColor.List =
ThisWorkbook.Names("dropdown_color").RefersToRange .Value
shDropdownTest.cboPattern.List =
ThisWorkbook.Names("dropdown_pattern").RefersToRan ge.Value
shDropdownTest.cboShape.List =
ThisWorkbook.Names("dropdown_shape").RefersToRange .Value
shDropdownTest.cboBigList.List =
ThisWorkbook.Names("dropdown_biglist").RefersToRan ge.Value
shDropdownTest.cboColor.Visible = False
shDropdownTest.cboPattern.Visible = False
shDropdownTest.cboShape.Visible = False
shDropdownTest.cboBigList.Visible = False


'this goes in the worksheet with the combobox controls:


Option Explicit

Dim dblLastMouseUpTime As Double

Private Sub cboBigList_Click()
'Odd behavior. Use MouseUp to determine when to run Click.
DropdownGotClicked cboBigList
End Sub

Private Sub cboBigList_MouseUp(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'Fires before dropdown's value is set to the clicked list item.
Use to determine when to run Click Event.
DropdownGotMouseUpped cboBigList
End Sub

Private Sub cboBigList_GotFocus()
DropdownGotFocus
End Sub

Private Sub cboBigList_KeyDown(ByVal KeyCode As MSForms.ReturnInteger,
ByVal Shift As Integer)
DropdownGotKeyDowned cboBigList, CInt(KeyCode), Shift
End Sub



Private Sub cboColor_Click()
'Odd behavior. Use MouseUp to determine when to run Click.
DropdownGotClicked cboColor
End Sub

Private Sub cboColor_MouseUp(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'Fires before dropdown's value is set to the clicked list item.
Use to determine when to run Click Event.
DropdownGotMouseUpped cboColor
End Sub

Private Sub cboColor_GotFocus()
DropdownGotFocus
End Sub

Private Sub cboColor_KeyDown(ByVal KeyCode As MSForms.ReturnInteger,
ByVal Shift As Integer)
DropdownGotKeyDowned cboColor, CInt(KeyCode), Shift
End Sub



Private Sub cboPattern_Click()
'Odd behavior. Use MouseUp to determine when to run Click.
DropdownGotClicked cboPattern
End Sub

Private Sub cboPattern_MouseUp(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'Fires before dropdown's value is set to the clicked list item.
Use to determine when to run Click Event.
DropdownGotMouseUpped cboPattern
End Sub

Private Sub cboPattern_GotFocus()
DropdownGotFocus
End Sub

Private Sub cboPattern_KeyDown(ByVal KeyCode As MSForms.ReturnInteger,
ByVal Shift As Integer)
DropdownGotKeyDowned cboPattern, CInt(KeyCode), Shift
End Sub



Private Sub cboShape_Click()
'Odd behavior. Use MouseUp to determine when to run Click.
DropdownGotClicked cboShape
End Sub

Private Sub cboShape_MouseUp(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
'Fires before dropdown's value is set to the clicked list item.
Use to determine when to run Click Event.
DropdownGotMouseUpped cboShape
End Sub

Private Sub cboShape_GotFocus()
DropdownGotFocus
End Sub

Private Sub cboShape_KeyDown(ByVal KeyCode As MSForms.ReturnInteger,
ByVal Shift As Integer)
DropdownGotKeyDowned cboShape, CInt(KeyCode), Shift
End Sub





Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim strTargetAddress As String
Dim iTargetCol As Long
Dim iTargetRow As Long
Dim bRet As Boolean

Debug.Print
Debug.Print "Worksheet_SelectionChange", Target.Address

strTargetAddress = Target.Cells(1).Address
iTargetCol = Target.Column

cboColor.Visible = False
cboPattern.Visible = False
cboShape.Visible = False
cboBigList.Visible = False

'show dropdown only if a single cell is selected:
If Target.Cells.Count 1 Then
Exit Sub
End If

Select Case iTargetCol
Case 1 ''''''''''' change to better way to determine column
''''''''''''''''''''''''''''''''''''''''''''''''''
bRet = DisplayComboBox(cboColor, strTargetAddress)
Case 2 ''''''''''' change to better way to determine column
''''''''''''''''''''''''''''''''''''''''''''''''''
bRet = DisplayComboBox(cboPattern, strTargetAddress)
Case 3 ''''''''''' change to better way to determine column
''''''''''''''''''''''''''''''''''''''''''''''''''
bRet = DisplayComboBox(cboShape, strTargetAddress)
Case 4 ''''''''''' change to better way to determine column
''''''''''''''''''''''''''''''''''''''''''''''''''
bRet = DisplayComboBox(cboBigList, strTargetAddress)

End Select

End Sub



Function DisplayComboBox(combo_box As MSForms.ComboBox, cell_address
As String) As Boolean

'returns True on success.

Debug.Print "DisplayComboBox", combo_box.Value, cell_address

combo_box.Visible = False
DoEvents
combo_box.Top = ActiveSheet.Range(cell_address).Top - 2.25
combo_box.Left = ActiveSheet.Range(cell_address).Left - 7.5
combo_box.height = ActiveSheet.Range(cell_address).height * 1.5
combo_box.width = ActiveSheet.Range(cell_address).width + 25
combo_box.Visible = True
DoEvents
combo_box.Activate
combo_box.SelText = ActiveSheet.Range(cell_address).Value
combo_box.SelStart = 0
combo_box.SelLength = Len(ActiveSheet.Range(cell_address).Value)

DisplayComboBox = True

End Function


Function DropdownGotFocus()

Debug.Print "DropdownGotFocus", Selection.Address

On Error Resume Next
DoEvents
SendKeys "%{DOWN}^a", True
End Function


Function DropdownGotClicked(combo_control As MSForms.ComboBox)

Debug.Print "DropdownGotClicked", combo_control.Value

If CDbl(Now) - dblLastMouseUpTime < 0.0000001 Then '~1/100sec
Selection.Formula = combo_control.Value
combo_control.Visible = False
Selection.Activate
End If
End Function


Function DropdownGotMouseUpped(Optional combo_control As
MSForms.ComboBox, _
Optional Button As Integer, Optional
Shift As Integer, _
Optional X As Single, Optional Y As
Single)

Debug.Print "DropdownGotMouseUpped", Now

dblLastMouseUpTime = Now
End Function


Function DropdownGotTabbed(combo_control As MSForms.ComboBox,
shift_keys As Integer)

Debug.Print "DropdownGotTabbed", combo_control.Value, shift_keys

On Error Resume Next
Selection.Formula = combo_control.Value
combo_control.Visible = False

If shift_keys = 0 Then
Selection.Offset(0, 1).Select
ElseIf shift_keys = 1 Then
Selection.Offset(0, -1).Select
End If
Selection.Activate
End Function


Function DropdownGotEnterKeyed(combo_control As MSForms.ComboBox,
shift_keys As Integer)

Debug.Print "DropdownGotEnterKeyed", combo_control.Value,
shift_keys

On Error Resume Next
Dim iRowOffset As Long
Dim iColOffset As Long

DoEvents

iRowOffset = 0 'init.
iColOffset = 0 'init.

Selection.Formula = combo_control.Value
combo_control.Visible = False

If Application.MoveAfterReturn Then
If Application.MoveAfterReturnDirection = xlDown Then
iRowOffset = 1
ElseIf Application.MoveAfterReturnDirection = xlToRight Then
iColOffset = 1
ElseIf Application.MoveAfterReturnDirection = xlUp Then
iRowOffset = -1
Else
'Application.MoveAfterReturnDirection = xlToLeft:
iColOffset = -1
End If

If shift_keys = 1 Then
'turn 1 into -1, and turn -1 into 1, and leave 0 as 0:
iRowOffset = iRowOffset * -1
iColOffset = iColOffset * -1
End If
End If
Selection.Offset(iRowOffset, iColOffset).Select
Selection.Activate
End Function


Function DropdownGotEscapeKeyed(combo_control As MSForms.ComboBox)

Debug.Print "DropdownGotEscapeKeyed", combo_control.Value

On Error Resume Next
combo_control.Visible = False
Selection.Activate
End Function


Function DropdownGotRightArrowed(combo_control As MSForms.ComboBox)

Debug.Print "DropdownGotRightArrowed"; combo_control.Value

On Error Resume Next
Selection.Formula = combo_control.Value
combo_control.Visible = False
Selection.Offset(0, 1).Select
Selection.Activate
End Function

Function DropdownGotLeftArrowed(combo_control As MSForms.ComboBox)

Debug.Print "DropdownGotLeftArrowed", combo_control.Value

On Error Resume Next
Selection.Formula = combo_control.Value
combo_control.Visible = False
Selection.Offset(0, -1).Select
Selection.Activate
End Function


Function DropdownGotKeyDowned(combo_control As MSForms.ComboBox,
key_code As Integer, shift_keys As Integer)

Debug.Print "DropdownGotKeyDowned", combo_control.Value, key_code,
shift_keys

On Error Resume Next
DoEvents
Select Case key_code
Case 27 'escape
DropdownGotEscapeKeyed combo_control
Case 39 'right arrow
DropdownGotRightArrowed combo_control
Case 37 'left arrow
DropdownGotLeftArrowed combo_control
Case 9 'tab
DropdownGotTabbed combo_control, shift_keys
Case 13 'enter key
DropdownGotEnterKeyed combo_control, shift_keys
End Select

End Function




Any ideas? Thanks for any help.


Thanks,

Greg Lovern