How to auto size listbox column

[Irish_Griffin]

Hello Everyone =-) Hope work / school / life is going well !!

I need to auto size the columns of an excel form listbox. Thought this would be a matter of finding the longest string and then setting the column width value...... I wish

Below, each line of text has 10 characters
xxxxxxxxxx
AAAAAAAAAA
IIIIIIIIII
d8aDNksd9m
bla Blah a

As you can see, the string length is not related to the displayed text width. How can determine the display width value? Perhaps my NooBy-Ness is not aware of a list box option that does column auto sizing for me??

Helps is always appreciated!!
-Griff

 

[alexofrhodes]

try adding the last two lines and let me know

    Set rng = rng.Resize(UBound(ctr.list) + 1, ctr.ColumnCount)
    rng = v 'ctr.List
    rng.Font.Name = ctr.Font.Size '<-
    rng.Font.Size = ctr.Font.Size + 2 '<-

 

[EXCEL MAX]

From my experience the best way to resize listbox column widths to the optimum is by using hidden label.
Here is example.
Add label to the userform.
Before code you need to set some properties of this control that may affect font width.

Private Sub UserForm_Initialize()
   
   Dim vRng As Range, vN1 As Integer, vN2 As Long, vTWidth As Long, vColWidth As String
   Const vSpace = 20

   With Label1
      .Font = ListBox1.Font
      .Font.Bold = ListBox1.Font.Bold
      .Font.Size = ListBox1.Font.Size
      .Font.Italic = ListBox1.Font.Italic
      .AutoSize = True
      .WordWrap = False
      .Visible = False
   End With
   
   With ActiveSheet
      Set vRng = .Range("A2:D10")
      ListBox1.ColumnCount = vRng.Columns.Count
      ListBox1.RowSource = .Name & "!" & vRng.Address
      For vN1 = 1 To vRng.Columns.Count
         For vN2 = 1 To vRng.Rows.Count
            Label1.Caption = vRng.Cells(vN2, vN1).Value
            If Label1.width > vTWidth Then vTWidth = Label1.width
         Next vN2
         vColWidth = vColWidth & "," & vTWidth + vSpace
         vTWidth = 0
      Next
      ListBox1.ColumnWidths = Mid(vColWidth, 2)
   End With
  
End Sub

 

[alexofrhodes]

if you could replace the listbox with a listview here is code to get that done better

Private Declare PtrSafe Function SendMessageLong _
Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long

Private Const LVM_FIRST = &H1000
Private Const LVM_SETCOLUMNWIDTH = (LVM_FIRST + 30)

Private Const LVSCW_AUTOSIZE = -1
Private Const LVSCW_AUTOSIZE_USEHEADER = -2


Private Sub UserForm_Activate()
For counter = 1 To ListView1.ColumnHeaders.count
Call SendMessageLong(ListView1.hwnd, LVM_SETCOLUMNWIDTH, counter - 1, LVSCW_AUTOSIZE_USEHEADER)
Next
End Sub