Hi came across this elegant Class module for changing the width of listbox columns. See the link below and scroll to the bottom of the link.
I am struggling to understand how to make this work. I incorporated a Call statement in my code where I have a fully populated listbox. Based on the guidance I call the private functions and pass my Listbox1 to them (see blue text). It then passes text from my listbox to temporarry text boxes to figure out the largest width,
It fails within the second function on the line of code below with a Runtime 424 Error (Object Required):
If l_ColumnWidths.Count > lPosCol Then (See Purple Text below)
I see that the l_ColumnWidths collections is declared in Initialize event (See red text), and I assume the private function does not have access to the properties. But I am not sure why this is.
I have done the following:
1) created a Class module called "clsListCtrlWidths"
****************
2) Put the following code in the Class Module
Option Explicit
Public m_ColWidthMax As Long
*************
3) Put the following code in the Initialize Event
*****************
Private Sub Userform_Initialize()
Dim l_ColumnWidths As Collection
Set l_ColumnWidths = New Collection
Dim cRows As Long
Dim i As Long
cRows = Range("XLSummaryImportRange").Rows.Count '- Range("XLSummaryImportRange").Row + 1
ListBox1.ColumnCount = Range("XLSummaryImportRange").Columns.Count
'Populate the listbox.
With Me.ListBox1
For i = 1 To cRows
'Use .AddItem property to add a new row for each record and populate column 0
.AddItem Range("XLSummaryImportRange").Cells(i, 1)
'Use .List method to populate the remaining columns
.List(.ListCount - 1, 1) = Range("XLSummaryImportRange").Cells(i, 2)
.List(.ListCount - 1, 2) = Range("XLSummaryImportRange").Cells(i, 3)
Next i
End With
'Change width of columns in listbox using Class
Call AutoSizeColsWidth(Me.ListBox1)
lbl_Exit:
Exit Sub
End Sub
***************************
4) Put the following 2 functions in place
*****************
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
**********************************
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 (FAILS ON THIS LINE OF CODE)
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
*******************
Thanks
Automatically adapt listbox column width
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.
stackoverflow.com
I am struggling to understand how to make this work. I incorporated a Call statement in my code where I have a fully populated listbox. Based on the guidance I call the private functions and pass my Listbox1 to them (see blue text). It then passes text from my listbox to temporarry text boxes to figure out the largest width,
It fails within the second function on the line of code below with a Runtime 424 Error (Object Required):
If l_ColumnWidths.Count > lPosCol Then (See Purple Text below)
I see that the l_ColumnWidths collections is declared in Initialize event (See red text), and I assume the private function does not have access to the properties. But I am not sure why this is.
I have done the following:
1) created a Class module called "clsListCtrlWidths"
****************
2) Put the following code in the Class Module
Option Explicit
Public m_ColWidthMax As Long
*************
3) Put the following code in the Initialize Event
*****************
Private Sub Userform_Initialize()
Dim l_ColumnWidths As Collection
Set l_ColumnWidths = New Collection
Dim cRows As Long
Dim i As Long
cRows = Range("XLSummaryImportRange").Rows.Count '- Range("XLSummaryImportRange").Row + 1
ListBox1.ColumnCount = Range("XLSummaryImportRange").Columns.Count
'Populate the listbox.
With Me.ListBox1
For i = 1 To cRows
'Use .AddItem property to add a new row for each record and populate column 0
.AddItem Range("XLSummaryImportRange").Cells(i, 1)
'Use .List method to populate the remaining columns
.List(.ListCount - 1, 1) = Range("XLSummaryImportRange").Cells(i, 2)
.List(.ListCount - 1, 2) = Range("XLSummaryImportRange").Cells(i, 3)
Next i
End With
'Change width of columns in listbox using Class
Call AutoSizeColsWidth(Me.ListBox1)
lbl_Exit:
Exit Sub
End Sub
***************************
4) Put the following 2 functions in place
*****************
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
**********************************
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 (FAILS ON THIS LINE OF CODE)
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
*******************
Thanks