Snasui Excel Forum

Code: Select all

Private Sub Worksheet_BeforeDoubleClick _
  (ByVal Target As Range, _
    Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim WS As Worksheet
Set WS = ActiveSheet

Set cboTemp = WS.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains
      'a data validation list
    Cancel = True
    Application.EnableEvents = False
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    
     'for simple INDIRECT function (English)
    ' e.g. =INDIRECT
    'will create dependent list of items
    If Left(str, 8) = "INDIRECT)" Then
      lSplit = InStr(1, str, "(")
      str = Right(str, Len(str) - lSplit)
      str = Left(str, Len(str) - 1)
      str = Range(str).Value
      
    End If
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 5
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.tempcombo.DropDown
  End If
  
errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub
'=========================================
Private Sub TempCombo_LostFocus()
  With Me.tempcombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub
'====================================

Code: Select all

'...other code
 Cancel = True
    Application.EnableEvents = False
      
    If InStr(Target.Offset(0, -1).Value, " ") Then
        str = Replace(Target.Offset(0, -1).Value, " ", "_")
    Else
        str = Target.Offset(0, -1).Value
    End If
    
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 5
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.tempcombo.DropDown
  End If
'...other code

Code: Select all

  Private Sub Worksheet_BeforeDoubleClick _
  (ByVal Target As Range, _
    Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim WS As Worksheet
Set WS = ActiveSheet

Set cboTemp = WS.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains
      'a data validation list
    '...other code
 Cancel = True
    Application.EnableEvents = False
      
    If InStr(Target.Offset(0, -1).Value, " ") Then
        str = Replace(Target.Offset(0, -1).Value, " ", "_")
    Else
        str = Target.Offset(0, -1).Value
    End If
    
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 5
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.tempcombo.DropDown
  End If
'...other code

  
errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub
'=========================================
Private Sub TempCombo_LostFocus()
  With Me.tempcombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub
'====================================