Automatically adapt listbox column width - vba

Question

I programmatically add elements from a database to a multicolumn listbox using this code :
Do While (Not rs.EOF)
ExistingSheetsListBox.AddItem
ExistingSheetsListBox.List(i, 0) = rs.Fields(0)
ExistingSheetsListBox.List(i, 1) = rs.Fields(1)
ExistingSheetsListBox.List(i, 2) = rs.Fields(2)
ExistingSheetsListBox.List(i, 3) = rs.Fields(3)
ExistingSheetsListBox.List(i, 4) = rs.Fields(4)
i = i + 1
rs.MoveNext
Loop
The insertion in the listbox works fine, but the column width is not always adapted to the length of the elements inserted in it, I would like to know how I can do so that the column width of each column is adapted to the text inserted into it.
EDIT : I used the solution proposed by #Excel Developers with the piece of code given by #HarveyFrench.

Answer 1

There is no autosize option, following sample code shows 2 ways to do this.
This does not take into account anything other than being a sample.
Class Module clsListCtrlWidths
'class option used so we can use Collection instead of an array.
Option Explicit
Public m_ColWidthMax As Long
Forms Module. Initialise somewhere
Dim l_ColumnWidths As Collection
Set l_ColumnWidths = New Collection
Forms Module functions
Private Function SetColWidth(stLen As String, ctCol1 As control, lPosCol As Long) As String
Dim stWidthTemp As String
If lPosCol > 0 Then
stWidthTemp = stLen & ";"
End If
Dim lTmpWidth As Long
Dim lColWidth As Long
lTmpWidth = ctCol1.Width
ctCol1.AutoSize = True
lColWidth = ctCol1.Width
ctCol1.AutoSize = False
ctCol1.Width = lTmpWidth
If l_ColumnWidths.Count > lPosCol Then
If l_ColumnWidths.Item(lPosCol + 1).m_ColWidthMax < lColWidth Then
l_ColumnWidths.Item(lPosCol + 1).m_ColWidthMax = lColWidth
Else
lColWidth = l_ColumnWidths.Item(lPosCol + 1).m_ColWidthMax
End If
Else
Dim clsColWidth As clsListCtrlWidths
Set clsColWidth = New clsListCtrlWidths
clsColWidth.m_ColWidthMax = lColWidth
l_ColumnWidths.Add clsColWidth
End If
stWidthTemp = stWidthTemp & lColWidth
SetColWidth = stWidthTemp
End Function
Following function takes listbox & calls on above function;
Private Function AutoSizeColsWidth(ByRef ctListCtrl As MSForms.ListBox)
Dim txtBoxDummy As control
Set txtBoxDummy = Me.Controls.Add("Forms.TextBox.1", "txtBoxDummy", False)
txtBoxDummy.AutoSize = True
Dim lRow As Long
Dim lCol As Long
Dim strColWidth As String
For lRow = 0 To ctListCtrl.ListCount - 1
For lCol = 0 To ctListCtrl.ColumnCount - 1
txtBoxDummy = ctListCtrl.List(lRow, lCol)
strColWidth = SetColWidth(strColWidth, txtBoxDummy, lCol)
Next lCol
Next lRow
ctListCtrl.ColumnWidths = strColWidth
End Function
Size Each time you add a single item
'assumes rs.Fields is a control or converted to control
Dim strColWidth As String
strColWidth = SetColWidth(strColWidth, rs.Fields(0), 0)
strColWidth = SetColWidth(strColWidth, rs.Fields(1), 1)
strColWidth = SetColWidth(strColWidth, rs.Fields(2), 2)
strColWidth = SetColWidth(strColWidth, rs.Fields(3), 3)
'etc
ctListCtrl.ColumnWidths = strColWidth
Or size once after adding lot of items
Call AutoSizeColsWidth(myListBox) 'call after completely loading listbox
Added as I was looking for a way to do this & OP is Google's top answer.

Answer 2

You can use the ColumnWidths property to set the size of the columns.
eg `ExistingSheetsListBox.ColumnWidths = "60;60;160;160;60"
For more info see here
I have not found anyway to automatically set the widths depending ont he data in each column, and I am pretty sure such a method does not exist.

Answer 3

Read the width of the existing column and assign it to a variable and use that in the listbox column property.
For Example You have six columns A to F and You need to auto fit the column F
FWidth = Columns("F").ColumnWidth * 7.6
ListBox1.ColumnWidths = "120,120,120,120,120," & FWidth & ""
The Multiply of 7.6 will converts the value to Points.
In Similar Way You can do it for all of Your columns.

Answer 4

Autosize Listbox and Combobox Columns with this function and Optionaly Resize Listbox/Combobox controls themselves.
Function ControlsResizeColumns(LBox As MSForms.Control, Optional ResizeListbox As Boolean)
Application.ScreenUpdating = False
Dim ws As Worksheet
If sheetExists("ListboxColumnWidth", ThisWorkbook) = False Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = "ListboxColumnwidth"
Else
Set ws = ThisWorkbook.Worksheets("ListboxColumnwidth")
ws.Cells.Clear
End If
'---Listbox/Combobox to range-----
Dim rng As Range
Set rng = ThisWorkbook.Sheets("ListboxColumnwidth").Range("A1")
Set rng = rng.Resize(UBound(LBox.List) + 1, LBox.ColumnCount)
rng = LBox.List
rng.Characters.Font.Name = UserForm1.ListBox1.Font.Name
rng.Characters.Font.Size = UserForm1.ListBox1.Font.Size
rng.Columns.AutoFit
'---Get ColumnWidths------
rng.Columns.AutoFit
Dim sWidth As String
Dim vR() As Variant
Dim n As Integer
Dim cell As Range
For Each cell In rng.Resize(1)
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = cell.EntireColumn.Width + 10 'if not some extra space it cuts a bit off the tail
Next cell
sWidth = Join(vR, ";")
Debug.Print sWidth
'---assign ColumnWidths----
With LBox
.ColumnWidths = sWidth
'.RowSource = "A1:A3"
.BorderStyle = fmBorderStyleSingle
End With
'----Optionaly Resize Listbox/Combobox--------
If ResizeListbox = True Then
Dim w As Long
For i = LBound(vR) To UBound(vR)
w = w + vR(i)
Next
DoEvents
LBox.Width = w + 10
End If
'remove worksheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function
Function sheetExists(sheetToFind As String, Optional InWorkbook As Workbook) As Boolean
If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook
On Error Resume Next
sheetExists = Not InWorkbook.Sheets(sheetToFind) Is Nothing
End Function