Better Way to Set ListBox Width Equals to Column Width

[Akanjana]

i written following code. as i am new to vba. can i get small version or alternative code to achieve the same. i want to auto size column width with worksheet column used cells max length.

'============Refresh ListBox===================
Public Function RefreshData()

Dim max As Integer
Dim Letter As String
Dim RngAddress As String
Dim C As Integer

'enable microsoft scripting runtime from tools ---> reference

Dim mydictionery As Scripting.Dictionary
Set mydictionery = New Scripting.Dictionary

C = 1
max = 0
Letter = "A"

For i = 1 To 26

RngAddress = Letter & 2 & ":" & Letter & 3

For Each cell In Range(RngAddress)
If Len(cell) > max Then max = Len(cell)
Next

mydictionery.Add Letter & max, 0 'add Letter & max to prevent duplicate key

max = 0 'reset max for next range
C = C + 1 'increase counter for dictionery
Letter = Chr(Asc(Letter) + 1) 'next column for range

Next i

Dim iRow As Long
Dim sh As Worksheet
    
Set sh = ThisWorkbook.Sheets("Database")
Last_Row = Application.WorksheetFunction.CountA(sh.Range("AB:AB"))

        With DataEntryFormDynamic.ListBox1

        
        .ColumnCount = 28
        .ColumnHeads = True
        
        .ColumnWidths = Mid(mydictionery.Keys(0), 2, 15) * 6 & "," & Mid(mydictionery.Keys(1), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(2), 2, 15) * 6 & "," & Mid(mydictionery.Keys(3), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(4), 2, 15) * 6 & "," & Mid(mydictionery.Keys(5), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(6), 2, 15) * 6 & "," & Mid(mydictionery.Keys(7), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(8), 2, 15) * 6 & "," & Mid(mydictionery.Keys(9), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(10), 2, 15) * 6 & "," & Mid(mydictionery.Keys(11), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(12), 2, 15) * 6 & "," & Mid(mydictionery.Keys(12), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(14), 2, 15) * 6 & "," & Mid(mydictionery.Keys(15), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(16), 2, 15) * 6 & "," & Mid(mydictionery.Keys(17), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(18), 2, 15) * 6 & "," & Mid(mydictionery.Keys(19), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(20), 2, 15) * 6 & "," & Mid(mydictionery.Keys(21), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(22), 2, 15) * 6 & "," & Mid(mydictionery.Keys(23), 2, 15) * 6 & "," _
                      & Mid(mydictionery.Keys(24), 2, 15) * 6 & "," & Mid(mydictionery.Keys(25), 2, 15) * 6 & ","
                 
        If Last_Row = 1 Then
        .RowSource = "Database!A2:AB2"
        Else
        .RowSource = "Database!A2:AB" & Last_Row
        End If
        End With
    
Set mydictionery = Nothing
End Function


'in userform

Private Sub userform activate ()
Call RefreshData
end sub

 

[Akanjana]

Please Note : i set monotype font "Courier New" for data worksheet.