how could autofit columns in listbox without specify values for each column

[tubrak]

Hi Guys

I need procedure to fit columns in listbox without specify values . should expand and contracts and control margins for width based on size of data for each column.

so when run the userform or search for data should autofill columns in listbox
I look forward to add some procedures to do that

Private Sub UserForm_Initialize()
  Dim LastRow As Long
  Set sh = ActiveSheet
  a = sh.Range("A1:F" & sh.Range("A" & Rows.Count).End(xlUp)).Value
  With MY_List
    .ColumnCount = 7
    .ColumnWidths = "20;50;100;100;70;70;70"
    Call CommandButton4_Click
  End With
End Sub
thanks

 

[Micron]

I'd say good luck with that idea. Each time you load the listbox the maximum character count over all the list items would have to be determined for each column. Then a width calculation for each count. If you don't use a fixed width font, then still probably would not work because characters like W are far wider than characters such as i, so how to allow for that. Far too much effort for 0 gain. If you're cramped for space then perhaps allow users to see the data in a larger format if they choose a list item that they can't see all of the column data. An example of that could be a userform.

 

[DanteAmor]

Try this:

Private Sub UserForm_Initialize()
  Dim i As Long
  Dim sWidths As String
  
  Set sh = ActiveSheet
  sh.Columns("A:F").EntireColumn.AutoFit
  a = sh.Range("A1:F" & sh.Range("A" & Rows.Count).End(xlUp).Row).Value
  
  For i = 1 To UBound(a, 2)
    sWidths = sWidths & Int(sh.Cells(1, i).Width) + 10 & ";"
  Next
  
  With MY_List
    .ColumnCount = UBound(a, 2)
    .ColumnWidths = sWidths
    Call CommandButton4_Click
  End With
End Sub

 

[tubrak]

thanks but shows a problem.
based on previous thread should add column BALANCE when write name or dates for text boxes , but column balance will not add it after replace your updating .

 

[DanteAmor]

but column balance will not add it after replace your updating

Try this:

Private Sub UserForm_Initialize()
  Dim i As Long
  Dim sWidths As String
  
  Set sh = ActiveSheet
  sh.Columns("A:G").EntireColumn.AutoFit
  a = sh.Range("A1:G" & sh.Range("A" & Rows.Count).End(xlUp).Row).Value
  
  For i = 1 To UBound(a, 2)
    sWidths = sWidths & Int(sh.Cells(1, i).Width) + 10 & ";"
  Next
  
  With MY_List
    .ColumnCount = UBound(a, 2)
    .ColumnWidths = sWidths
    Call CommandButton4_Click
  End With
End Sub

 

[tubrak]

thanks again
I want share with you the picture
seem the last column could be far in space with comparison the other columns but not much .
I don't want to make hard the matter for you , just I ask if could make it the same space as the others columns.

 

[DanteAmor]

Try:

Private Sub UserForm_Initialize()
  Dim i As Long
  Dim sWidths As String
  
  Set sh = ActiveSheet
  sh.Columns("A:F").EntireColumn.AutoFit
  a = sh.Range("A1:F" & sh.Range("A" & Rows.Count).End(xlUp).Row).Value
  
  For i = 1 To UBound(a, 2)
    sWidths = sWidths & Int(sh.Cells(1, i).Width) + 10 & ";"
    If i = 6 Then
      sWidths = sWidths & Int(sh.Cells(1, i).Width) + 10 & ";"
    End If
  Next
  
  With MY_List
    .ColumnCount = UBound(a, 2) + 1
    .ColumnWidths = sWidths
    Call CommandButton4_Click
  End With
End Sub

 

[tubrak]

thanks
unfortunately is still far

 

[DanteAmor]

Another change, with the following columns 5, 6 and 7 (debit, credit, balance) have the same size.

Private Sub UserForm_Initialize()
  Dim i As Long, nmax As Long
  Dim sWidths As String
  
  Set sh = ActiveSheet
  sh.Columns("A:F").EntireColumn.AutoFit
  a = sh.Range("A1:F" & sh.Range("A" & Rows.Count).End(xlUp).Row).Value
  
  For i = 1 To 4
    sWidths = sWidths & Int(sh.Cells(1, i).Width) + 10 & ";"
  Next
  nmax = WorksheetFunction.Max(Int(sh.Cells(1, "E").Width), Int(sh.Cells(1, "F").Width))
  sWidths = sWidths & nmax + 10 & ";" & nmax + 10 & ";" & nmax + 10
  
  With MY_List
    .ColumnCount = 7
    .ColumnWidths = sWidths
    Call CommandButton4_Click
  End With
End Sub

 

[tubrak]

doesn't change anything
see the file could help you
customers1.xlsm