Option Compare Database
Option Explicit
Private WithEvents mTextBox As Access.TextBox
Private WithEvents mListBox As Access.ListBox
Private mHeightPixels As Integer
Private mUpdateTextBox As Boolean
Private mVisibleColumn As Integer
Private WithEvents mForm As Access.Form
Public Sub Initialize(TheTextBox As Access.TextBox, TheListBox As Access.ListBox, Optional HeightInInches = 1, Optional UpdateTextBox As Boolean = True)
  Set mTextBox = TheTextBox
  Set mListBox = TheListBox
  mHeightPixels = HeightInInches * 1440
  With mTextBox
    .OnMouseDown = "[Event Procedure]"
    .OnKeyDown = "[Event Procedure]"
    .OnMouseUp = "[Event Procedure]"
    .OnKeyUp = "[Event Procedure]"
    .Locked = True
  End With
  With mListBox
    .Left = mTextBox.Left
    .Height = 0
    .Top = mTextBox.Top + mTextBox.Height
    .Width = mTextBox.Width
    .AfterUpdate = "[Event Procedure]"
    .OnMouseDown = "[Event Procedure]"
    .OnKeyDown = "[Event Procedure]"
    .OnClick = "[Event Procedure]"
  End With
  Set mForm = TheTextBox.Parent
  mForm.OnCurrent = "[Event Procedure]"
  mUpdateTextBox = UpdateTextBox
  SetVisibleColumn
End Sub
Private Sub SetVisibleColumn()
  Dim aWidths() As String
  Dim i As Integer
  If mListBox.ColumnCount > 0 And mListBox.ColumnWidths <> "" Then
      aWidths = Split(mListBox.ColumnWidths, ";")
      For i = 0 To UBound(aWidths)
        If aWidths(i) <> "0" Then
          mVisibleColumn = i
          Exit For
         End If
      Next i
    End If
End Sub
Private Sub mForm_Current()
  mListBox.Visible = False
End Sub
Private Sub mForm_Load()
End Sub
Private Sub mListBox_AfterUpdate()
   If mUpdateTextBox Then mTextBox.Value = mListBox.Column(mVisibleColumn)
  'ShrinkList
End Sub
Private Sub mListBox_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = 13 Then
     mTextBox.SetFocus
     ShrinkList
  End If
  'Causes some random value to get selected
End Sub
Private Sub mListBox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  ShrinkList
  'For some reason causes the value to not select
End Sub
Private Sub mTextBox_KeyDown(KeyCode As Integer, Shift As Integer)
 ExpandList
End Sub
Private Sub mTextBox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  ExpandList
End Sub
Public Sub ExpandList()
  With mListBox
    .Height = mHeightPixels
    .Top = mTextBox.Top + mTextBox.Height
    .Visible = True
    .SetFocus
    .BorderStyle = 1
  End With
End Sub
Public Sub ShrinkList()
    With mListBox
        'for some strange reason cannot make height very small such as 0. The value will not select every other time.
        .Height = 60
        .BorderStyle = 0
    End With
 End Sub