Adjust Listbox.Height problems

Question

I have a userform with a textbox and a listbox with the following plan:

1. Users input text in Textbox1.
2. Every time Textbox1.Text changes, a search with the following features is performed:
   • Textbox1.Text is searched in a specific range in a worksheet.
   • Textbox1.Text can be found more than once.
   • Listbox1 is populated with the results of the search.

So far so good. Due to having large set of data, the list can get many items. In this case the list reaches out of the screen and I had to limit Listbox1.Height. This is the code for the above:

Private Sub TextBox1_Change()
    Dim srchWord As String, firstAddress As String
    Dim srchRng As Range, cell As Range
    Dim maxRow As Integer

    ListBox1.Clear
    If TextBox1.Value = "" Then
        ListBox1.Height = 0
    Else
        With ThisWorkbook.Worksheets(1)
            maxRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            Set srchRng = .Range("A2:A" & maxRow)
        End With
        srchWord = TextBox1.Value
        Set cell = srchRng.Find(srchWord, LookIn:=xlValues, lookat:=xlPart)

        With ListBox1
        If Not cell Is Nothing Then
            firstAddress = cell.Address
            Do
                If Not cell.Value Like "*(*" Then
                    .AddItem (cell.Value)
                    Select Case .ListCount
                        Case Is < 2
                            .Height = 17
                        Case Is < 21
                            .Height = 15 * .ListCount
                        Case Else
                            .Height = 272.5
                    End Select
                    Me.Height = 500
                End If
                Set cell = srchRng.FindNext(cell)
            Loop While Not cell.Address = firstAddress
        End If
        End With
    End If
End Sub

The problem was in Case Else when scroll was enabled I couldn't reach the last item of the list. By searching on the net I found some potential solutions:

• set Listbox1.IntegralHeight = False set the height and then set again Listbox1.IntegralHeight = True
• set Listbox1.MultiSelect = fmMultiSelectSingle and then set again Listbox1.MultiSelect = fmMultiSelectExtended.
• do both of the above.
• Application.Wait (Now + TimeValue("0:00:01") * 0.5) and then set the height.

None of these worked. To be able to scroll to the last item, this worked:

Listbox1.IntegralHeight = False
Listbox1.Height= x
Listbox1.IntegralHeight = False
Listbox1.Height= x

but this also set the Listbox1.Height to this of one single item. (with arrows at the right)

Does anybody know how on earth am I going to control the Listbox1.Height without all this unwanted behaviour? Also if somebody can suggest another structure that could follow the plan mentioned at first, I 'm willing to discard the listbox.

Answer 1

This seems to be a not completely explored behaviour.

• In my experience just redefine some listbox arguments.

• Try the recommended sets of .IntegralHeight to False and True.

• Another possible measure can help in some cases: try to choose heights for your listbox that come close to the following multiplication:

listbox height = (font size + 2 pts) * (maximum items per page)

Insert the following code after With ListBox1:

  With ListBox1
    .Top = 18                   ' << redefine your starting Point
    .Font.Size = 10             ' << redefine your font size
    .IntegralHeight = False     ' << try the cited recommendation :-)

Insert the following code before End With:

    .Height = .Height + .Font.Size + 2
    .IntegralHeight = True
    End With

Hope that helps.

Link

See another faster approach to filter listboxes at How to speed up filling of listbox values on userform excel

Answer 2

@T.M.: Thank you for your quick response and for your time. Your answer gave me exactly what I wanted and that's why I'm marking it as such. I'm posting this just for future reference.

What I finaly did to implement the plan.

• First of all I inserted:

this

With ListBox1
    .Top = 18
    .Font.Size = 10
    .IntegralHeight = False

and this

    .Height = .Height + .Font.Size + 2
    .IntegralHeight = True
End With

and I linked .Height with .Font.Size as you suggested. As long as there was no need to assign absolute values to the height, there was no need to have a Select Case statement in my code.

• Moreover I realized that there was no need to change the height every time an item was added but only at the end of the process, so I took it out of the loop.

• Finally I added a piece of code that would make the list invisible when Textbox1 was empty. The code is now like this:

Final Userform code:

Option Compare Text
Option Explicit

Private bsdel As Boolean 'indicates if backspace or delete keys have been hit.


Private Sub ListBox1_Click()
    Dim cell As Range
    Dim maxRow As Integer

    With ThisWorkbook.Worksheets(1)
        maxRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        Set cell = .Range("A1:A" & maxRow).Find(UserForm11.ListBox1.Text, LookIn:=xlValues, lookat:=xlWhole)
        If Not cell Is Nothing Then 
            cell.Select
            'do other stuff also.
        End If
    End With
End Sub


Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    bsdel = False
    If KeyCode = 8 Or KeyCode = 46 Then _
        bsdel = True
End Sub

Private Sub TextBox1_Change()
    Dim srchWord As String, firstAddress As String
    Dim srchRng As Range, cell As Range
    Dim maxRow As Integer

    ListBox1.Clear
    ListBox1.Visible = True
    If bsdel And TextBox1.Value = "" Then
        ListBox1.Visible = False
        Me.Height = 130
    Else
        With ThisWorkbook.Worksheets(1)
            maxRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            Set srchRng = .Range("A1:A" & maxRow)
        End With
        srchWord = TextBox1.Value
        Set cell = srchRng.Find(srchWord, LookIn:=xlValues, lookat:=xlPart)

        With ListBox1
            '.Top = 84          'test made: deleting this made no difference.
            '.Font.Size = 10    'test made: deleting this made no difference.
            .IntegralHeight = False

            If Not cell Is Nothing Then
                firstAddress = cell.Address
                Do
                    If Not cell.Value Like "*(*" Then 'this range includes notes within parenthesis and I didn't need them.
                        .AddItem (cell.Value)
                    End If
                    Set cell = srchRng.FindNext(cell)
                Loop While Not cell.Address = firstAddress
                If .ListCount < 21 Then 'the size is adjusted.
                    .Height = (.Font.Size + 2) * .ListCount
                Else 'the size stays fixed at maximum.
                    .Height = (.Font.Size + 2) * 20
                End If
            End If
            Me.Height = .Height + 130

            .Height = .Height + .Font.Size + 2 
            .IntegralHeight = True
        End With
    End If
    bsdel = False
End Sub


Private Sub UserForm_Activate()
    TextBox1.SetFocus
End Sub


Private Sub UserForm_Initialize()
    ListBox1.Visible = False
End Sub