Omit blanks from activex combo box list

[j2mbs]

Hello Wizards

I am stuck after 2 hours of google searching, and trial and error. I have decided to defer to you for help.

I found some cool code to turn my data validation boxes into searchable combo boxes making the spreadsheet user's life much easier. However the code does not omit blank in my data validation name range causing the scroll bar to be very sensitive due to the name range being the entire column B. Is there a way to modify my code below to omit blank cells?

A little bit of backgound:

1. I have 100+ rows with data validation in column B of Sheet1. Each cell in column B now defaults to the searchable combo box.
2. The name range is located on Sheet2 and is the entire column B.
I use the entire column in order to keep the range dynamic because another macro is used to update the data on Sheet2 which can increase/decrease from month to month. Naming
the entire column ensures I always capture everything.


Any help you can provide is always greatly appreciated.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2017/8/15
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("EmpListCombo")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    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
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.EmpListCombo.DropDown
    End If
End Sub
Private Sub EmpListCombo_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

 

[Jerry Sullivan]

Hi jm2bs,

Assuming that you are just trying to eliminate the blanks after your list and you don't have any blanks within the list range, you could use a Dynamic Named Range instead of a reference to all of Column B.

To do that:
1. Define a Range with name "Employees" that refers to:
=MyData!$B$2:INDEX(MyData!$B:$B,MAX(1,COUNTA(MyData!$B:$B)-1))

Replace MyData with the actual name of your worksheet. This formula assumes your list starts on Row 2 of that sheet and has a header on Row 1.

There's a couple of problems with that code example from ExtendOffice. The statement Cancel = True is not valid (this was probably originally written to be used in a BeforeDoubleClick event that has a Cancel parameter). Also the placement On Error Resume Next near the top of the code is not a best practice. It actually causes the code to skip over this statement when it errors on a cell without Validation...

If Target.Validation.Type = 3 Then

...then execute next lines of code as if that statement had been True.

Here's a slightly modified version you might consider using instead...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2017/8/15, modified by jsullivan 2017/12/16
    Dim bHasListValidation As Boolean
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Set xWs = Application.ActiveSheet
    Set xCombox = xWs.OLEObjects("EmpListCombo")
    
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    
    On Error Resume Next
    bHasListValidation = Target.Validation.Type = 3
    On Error GoTo 0
    
    If bHasListValidation Then
        Target.Validation.InCellDropdown = False
        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
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.EmpListCombo.DropDown
    End If
End Sub

Private Sub EmpListCombo_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