Hi every one i noticed a few questions asking if there is a way to limit this to one column but i didn't notice any answers, was this ever figured out? i have multiple drop downs in my work sheet and they are all being affected by the macro where i only want column H to be affected. Any help with this would be greatly appreciated.
- To post as a guest, your comment is unpublished.Hi Rob K,
The below VBA code can help you solve the problem, please have a try and thank you for your comment.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2019/8/14
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Dim xArr
Dim xRgStr As String
Dim xRg As Range
xRgStr = "H:H"
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("TempCombo")
With xCombox
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
Set xRg = Intersect(Range(xRgStr), Target)
If xRg Is Nothing Then Exit Sub
If Target.Validation.Type = 3 Then
Target.Validation.InCellDropdown = False
Cancel = True
xStr = Target.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
If xStr = "" Then Exit Sub
With xCombox
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = xStr
If .ListFillRange = "" Then
xArr = Split(xStr, ",")
Me.TempCombo.List = xArr
End If
.LinkedCell = Target.Address
End With
xCombox.Activate
Me.TempCombo.DropDown
End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub- To post as a guest, your comment is unpublished.Hi,I am trying to pull that list data from another sheet but it does not work. below is my codePrivate Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 20190812
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Dim xArr
Dim xRgStr As String
Dim xRg As Range
xRgStr = "MAINInput!$D:$D"
'MAINInput = sheet name where the list is available
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("cmbEmployee")
With xCombox
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
Set xRg = Intersect(Range(xRgStr), Target)
If xRg Is Nothing Then Exit Sub
If Target.Validation.Type = 3 Then
Target.Validation.InCellDropdown = False
Cancel = True
xStr = Target.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
If xStr = "" Then Exit Sub
With xCombox
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = xStr
If .ListFillRange = "" Then
xArr = Split(xStr, ",")
Me.cmbEmployee.List = xArr
End If
.LinkedCell = Target.Address
End With
xCombox.Activate
Me.cmbEmployee.DropDown
End If
End Sub
Private Sub cmbEmployee_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub - To post as a guest, your comment is unpublished.Thank you for this fix! One quick question: I running this code across multiple worksheets (31 to be exact) but it is only affecting one. I have the code the same for each worksheet limiting the columns but it doesn't seem to be working on the other sheets. Thanks in advance!
- To post as a guest, your comment is unpublished.Hi Rob K,
The below VBA code can help you solve the problem. Thank you for your comemnt.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 20190812
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Dim xArr
Dim xRgStr As String
Dim xRg As Range
xRgStr = "H:H" 'The range of cells containg drop-down lists you will make them autocomplete
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("TempCombo")
With xCombox
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
Set xRg = Intersect(Range(xRgStr), Target)
If xRg Is Nothing Then Exit Sub
If Target.Validation.Type = 3 Then
Target.Validation.InCellDropdown = False
Cancel = True
xStr = Target.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
If xStr = "" Then Exit Sub
With xCombox
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = xStr
If .ListFillRange = "" Then
xArr = Split(xStr, ",")
Me.TempCombo.List = xArr
End If
.LinkedCell = Target.Address
End With
xCombox.Activate
Me.TempCombo.DropDown
End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub
