Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88066

Multiple Combo Box Drop down

$
0
0

I am trying to create a table with dropdown lists. To help users, I would like to make use of combo boxes for its autofill functionality.

Currently I have a code for the combo box. This code calls for the combo box whenever a cell in a given table column is double-clicked.

My table has 4 columns that I would like for this code to work. 1. Employee Name 2. Employment Status 3. System Name 4. Access Rights

Needless to say, I have also created four (4) combo boxes for each column. So far, my code only works for one column and does not work if I have four.

I only copied the code online and tried to modify it but somehow I can't make it to work.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim str As String Dim cboTemp1 As OLEObject Dim cboTemp2 As OLEObject Dim cboTemp3 As OLEObject Dim cboTemp4 As OLEObject Dim ws As Worksheet

If Selection.Count = 1 Then

'EmployeeName

    If Not Intersect(Target, Range("inputEmployeeName")) Is Nothing Then
        Set ws = ActiveSheet
        Set cboTemp1 = ws.OLEObjects("cboEmployeeName")
          On Error Resume Next
          With cboTemp1
          '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
            'get the data validation formula
            str = Target.Validation.Formula1
            str = Right(str, Len(str) - 1)
            With cboTemp1
              '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
            cboTemp1.Activate
            'open the drop down list automatically
            Me.cboEmployeeName.DropDown
          End If

'EmploymentStatus

    ElseIf Not Intersect(Target, Range("inputEmploymentStatus")) Is Nothing Then
        Set ws = ActiveSheet
        Set cboTemp2 = ws.OLEObjects("cboEmploymentStatus")
          On Error Resume Next
          With cboTemp2
          '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
            'get the data validation formula
            str = Target.Validation.Formula1
            str = Right(str, Len(str) - 1)
            With cboTemp2
              '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
            cboTemp2.Activate
            'open the drop down list automatically
            Me.cboEmploymentStatus.DropDown
          End If

'SystemName

    ElseIf Not Intersect(Target, Range("inputSystemName")) Is Nothing Then
        Set ws = ActiveSheet
        Set cboTemp3 = ws.OLEObjects("cboSystemName")
          On Error Resume Next
          With cboTemp3
          '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
            'get the data validation formula
            str = Target.Validation.Formula1
            str = Right(str, Len(str) - 1)
            With cboTemp3
              '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
            cboTemp3.Activate
            'open the drop down list automatically
            Me.cboSystemName.DropDown
          End If

'AccessRights

    ElseIf Not Intersect(Target, Range("inputAccessRights")) Is Nothing Then
        Set ws = ActiveSheet
        Set cboTemp4 = ws.OLEObjects("cboAccessRights")
          On Error Resume Next
          With cboTemp4
          '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
            'get the data validation formula
            str = Target.Validation.Formula1
            str = Right(str, Len(str) - 1)
            With cboTemp4
              '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
            cboTemp4.Activate
            'open the drop down list automatically
            Me.cboAccessRights.DropDown
          End If

    Else

errHandler: Application.EnableEvents = True Exit Sub

    End If
End If

End Sub


Viewing all articles
Browse latest Browse all 88066

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>