Resizing a Listbox and its Userform to adjust to items in the Listbox

[chazrab]

A Find search gave these two results. The listbox Height will always adjust to 1 blank row below the last item found. The userform Height and OK button adjusts to the same location from the bottom of Listbox1 for each different result. I have never gotten this to work properly every time all the time using Resize together with Listbox1.Height and Userform1.Height. code. Has anyone been able to get this to work properly every time? I'm frustrated and would really appreciate anyone's help on this.
Thanks for anyone's help.
cr

 

[EXCEL MAX]

HelloChazrab,
here is example...

Option Explicit

Dim varListHeight, varDifference

Private Sub UserForm_Click()

    varListHeight = lst1.Height     'store height to variable befor change
    lst1.Height = 30
    varDifference = varListHeight - lst1.Height       'calculate difference
    btn1.Top = btn1.Top - varDifference
    UF1.Height = UF1.Height - varDifference
    
End Sub

 

[smozgur]

Assuming the object names as default, i.e. ListBox1, CommandButton1. Change them if necessary.
Copy and paste the following code to the UserForm1 class module, UserForm_Initialize event procedure.

Note that I limited the ListBox1 height by comparing it with the Application height, so it shouldn't go out of the screen edges.

Private Sub UserForm_Initialize()
    ' This is just for filling the list box
    ' If you are setting the listbox rowsource property
    ' then just remove this section
    ' Otherwise you need to execute the actual code
    ' only after populating the listbox content
    ' =====================================
    Dim i As Integer
    For i = 1 To 10
        ListBox1.AddItem i
    Next i
    ' =====================================
  
    ListBox1.Height = Application.WorksheetFunction.Min(ListBox1.Font.Size * 1.25 * (ListBox1.ListCount + 1), Application.Height / 2)
    CommandButton1.Top = ListBox1.Height + ListBox1.Top + 10
    ' First 20 is the command button bottom padding,
    ' second 20 is the userform caption bar height
    Me.Height = CommandButton1.Top + CommandButton1.Height + 20 + 20
End Sub

 

[chazrab]

Hi smozgur - code does not work. All images below should be self explanatory. If you can see that I did anything
wrong, please let me know. Your code produced the one row reduced listbox. The correct code should result in the very last image at the bottom. The Rowsource was left blank per your instructions, but the code didn't resize as it should have in the last image. Again, thanks for all your help. cr

 

[smozgur]

The Rowsource was left blank per your instructions, but the code didn't resize as it should have in the last image.

The part in my code which is creating sample items in the ListBox was for "sample" only. Because I didn't know how you fill the ListBox.
Set the RowSource property as before, =Sheet1!A1:B8 (use your own worksheet name), keep the code as you took the screenshot above, and load the user form. Then it will work as it should.

 

[smozgur]

Oh, this comment probably caused confusion.

    ' This is just for filling the list box
    ' If you are setting the listbox rowsource property
    ' then just remove this section
    ' Otherwise you need to execute the actual code
    ' only after populating the listbox content
    ' =====================================
    Dim i As Integer
    For i = 1 To 10
        ListBox1.AddItem i
    Next i
    ' =====================================

I tried to explain, this "section", the code for filling the list box, is just a sample to make the list box has some items, so we can see how it works.

1. If you are setting the RowSource property, now I know you do that, keep the RowSource property as it is but remove "this section" from the code. Just as you commented out.
2. If you are not setting the RowSource property but filling the list box in the code, then you do that first and then run the actual code that I sent for the resizing job.

You need to do #1. And it looks like the following:

Result

#2 for future readers.

Edit: Oops! ListBox1 IntegralHeight property (in the properties window in VBA) must be also set to False. I just realized that I didn't mention that.

 

[EXCEL MAX]

For those who need more precise and for those who intend to change the font size frequently ... Try this method.
You can add virtual "Label" control dinamically or you can add "Label" control inside Userform and hide it.
The "Label" control can imitate one line in the ListBox control.

Option Explicit

Dim varLabelX As Object
Dim varNRows As Long
Dim varHeightIndex, varDifference


Private Sub UserForm_Initialize()
    
    Call CreateVirtualLabel
   
End Sub


Sub CreateVirtualLabel()
    
    Set varLabelX = Controls.Add("Forms.Label.1", "LabelX", True)
    With varLabelX
        .Top = -100
        .Caption = "LabelX"
        .Left = -100
        .AutoSize = True
        .WordWrap = False
    End With
    Set varLabelX.Font = ListBox1.Font
    varHeightIndex = Controls("LabelX").Height
    Call ResizeListbox
    
End Sub


Sub ResizeListbox()

    varDifference = CommandButton1.Top - ListBox1.Height - ListBox1.Top
    varNRows = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    ListBox1.RowSource = "Sheet1!A1:A" & varNRows + 1
    ListBox1.Height = (varNRows + 1) * varHeightIndex
    ListBox1.RowSource = "Sheet1!A1:A" & varNRows
    CommandButton1.Top = ListBox1.Top + ListBox1.Height + varDifference
    ListBox1.IntegralHeight = False
    
End Sub


Private Sub UserForm_Terminate()
    
    Controls.Remove "LabelX"
    
End Sub