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