3
\$\begingroup\$

I recently had quite a lot of fun answering a Stack Overflow question, and I think I've gone a bit overboard and ended up with a fairly decent way of populating a ComboBox from a Range.

Given a simple UserForm featuring some ComboBox1 control that I'd want to populate from a ListObject on Sheet1, the calling/client code looks like this:

Option Explicit

Sub Test()
    With New UserForm1
        .PopulateFromList Sheet1.ListObjects(1)
        .Show vbModal
    End With
End Sub

move list, with a hidden ID column dropdown with column headings

(thanks to Thomas Inzina for helping with the column headings)

...the Change handler in the form's code is just to illustrate that the hidden ID column is effectively being used as the Combobox.Value:

Private Sub ComboBox1_Change()
    If Not IsNull(ComboBox1.Value) Then Debug.Print ComboBox1.Value, ComboBox1.Text
End Sub

And it works!

 3            Star Wars
 1            Lord of the Rings

Here's the rest of the form's code-behind, the actual code under review - I'm wondering what's the best way to reuse it, I haven't decided whether it's best to extract it into a class module as a utility; with a WithEvents foo As ComboBox field I could be having a dynamic control there... it's certainly not practical in the code-behind of some random form though.

I'm not very happy with GetColumnWidths, I'm sure there's a better way to do this. As for the PopulateFromXxxx methods, ...they're perfect, aren't they? ;-)

Option Explicit

Public Sub PopulateFromList(ByVal source As ListObject, Optional ByVal valueColumn As Long = 1, Optional ByVal hasHeader As Boolean = True)
    With Me.ComboBox1
        .ColumnCount = source.Range.Columns.Count
        .ColumnWidths = GetColumnWidths(source.Range)
        .ListWidth = IIf(ComboBox1.Width > source.Range.Width, ComboBox1.Width, source.Range.Width)
        .RowSource = source.Name & "[#Data]"
        .BoundColumn = valueColumn
        .ColumnHeads = hasHeader
    End With
End Sub

Public Sub PopulateFromArray(ByVal source As Range, Optional ByVal valueColumn As Long = 1, Optional ByVal hasHeader As Boolean = True)
    With Me.ComboBox1
        .ColumnCount = source.Columns.Count
        .ColumnWidths = GetColumnWidths(source)
        .ListWidth = IIf(ComboBox1.Width > source.Width, ComboBox1.Width, source.Width)
        .List = source.Range(source.Rows(IIf(hasHeader, 2, 1)).EntireRow, source.Rows(source.Rows.Count).EntireRow).Value
        .BoundColumn = valueColumn
    End With
End Sub

Private Function GetColumnWidths(ByVal source As Range) As String
    Dim cols As Long
    cols = source.Columns.Count

    Dim widths()
    ReDim widths(1 To cols)
    Dim col As Long
    For col = 1 To cols
        widths(col) = source(, col).Width
    Next
    GetColumnWidths = Join(widths, ",")
End Function

Is there any way to clean this up? The .List assignment in PopulateFromArray seems particularly painful.

\$\endgroup\$
  • \$\begingroup\$ I did a spin off of you work to answer this question: Excel ComboBox - Autosize Dropdown Only. His list was filled by a recordset and not a range. \$\endgroup\$ – user109261 Sep 22 '16 at 11:54
3
\$\begingroup\$

I'm not sure I'd compare the .width properties of a control and a range - hear me out.

Let's start with a table of relevant measurements

Inch       .5
cm         1.27
Pixel      48
Point      36
Characters 5.38

With a Range

In the excel UI you see two numbers - characters and pixels when manually adjusting width.

Characters being the number of characters with the font (I'm using default here- calibri 11) that can fit in the width of the range (yes, that's a ridiculous measurement unit).

In the Format menu for a range, the Column Width is also characters.

In VBA

Range.Width = points (Variant Double)
Range.ColumnWidth = characters (Variant Double)

.width here is giving us points which then must be divided by .75 to get to pixels to match the UI.

With a Form

The properties of an active x combobox on a form are

ComboBox1.ColumnWidths = points (String)
ComboBox1.Width = pixels (Single)
ComboBox1.ListWidth = points (String)

In the code

.ColumnWidths = GetColumnWidths(source.Range)
.ListWidth = IIf(ComboBox1.Width > source.Range.Width, ComboBox1.Width, source.Range.Width)

Essentially you set .ColumnWidths (String in points) with a String representing points. Nice.

Then you compare pixels to points and set ListWidth (String in points) with either pixels (as Single) or points (Variant Double).

There's no avoiding this mess, so I would break out another function that returns a String of points.

Yes, it's needlessly complicated to do so, unless someone is trying to debug some more complex version of this or you're like me and you hate that excel has done this.

    Dim myControlBox As Control
    Set myControlBox = Me.ComboBox1
    With myControlBox
        .ColumnCount = source.Columns.Count
        .ColumnWidths = GetColumnWidths(source)
        .ListWidth = GetListWidth(source, myControlBox)
    End With

Private Function GetListWidth(ByVal source As Range, ByVal myControlBox As Control) As String
    If myControl.Width > source.Width Then
        GetListWidth = myControl.Width * 0.75
        Exit Function
    Else: GetListWidth = source.Width
End Function

This answer took me longer to write that I'm willing to admit.

\$\endgroup\$
  • \$\begingroup\$ Very interesting. Interestingly when I dragged the form right under the source table and visually lined up the dropdown with the ListObject, the width of the dropdown (and columns) did seem to match exactly. \$\endgroup\$ – Mathieu Guindon Sep 12 '16 at 21:40
  • 3
    \$\begingroup\$ Yes, it would (and does) work fine as it is, but I could see VBA being a tricky bastard and getting confused at some point. \$\endgroup\$ – Raystafarian Sep 12 '16 at 21:42
2
\$\begingroup\$

I was wrong about the column heads. They display properly when you are using RowSource but not List.

I think that using a custom Type to wrap up the functionality, really cleans up the code.

Demo

enter image description here

Code

Type ListSettings
    ColumnCount As Integer
    ColumnWidths As String
    ListWidth As String
    List As Variant
    RowSource As String
End Type

Function getListSettings(Source As Range, Optional ByVal hasHeader As Boolean = True) As ListSettings
    Dim r As Range
    Dim t As ListSettings
    Dim s As String

    For Each r In Source.Rows(1).Cells
        s = s & r.Width & ","
    Next
    'This works because Boolean Logic evaluates to -1 for True and 0 for False.
    Set Source = Source.Offset(Abs(hasHeader)).Resize(Source.Rows.Count + hasHeader)

    With t
        .ColumnCount = Source.Columns.Count
        .ColumnWidths = Left(s, Len(s) - 1)
        .ListWidth = Source.Width
        .List = Source
        .RowSource = Source.Address
    End With

    getListSettings = t
End Function

Userform

Private Sub UserForm_Initialize()
    Dim t As ListSettings
    t = getListSettings(Sheet1.ListObjects(1).Range)

    With ListBox1
        .ColumnCount = t.ColumnCount
        .ColumnWidths = t.ColumnWidths
        .RowSource = t.RowSource
        .ColumnHeads = True
    End With

    With ListBox2
        .ColumnCount = t.ColumnCount
        .ColumnWidths = t.ColumnWidths
        .RowSource = t.RowSource
        .ColumnHeads = True
    End With

    With ComboBox1
        .ColumnCount = t.ColumnCount
        .ColumnWidths = t.ColumnWidths
        .List = t.List
        .ColumnHeads = True
        If .Width < t.ListWidth Then .ListWidth = t.ListWidth
    End With

    With ComboBox2
        .ColumnCount = t.ColumnCount
        .ColumnWidths = t.ColumnWidths
        .RowSource = t.RowSource
        .ColumnHeads = True
        .ListWidth = IIf(.ListWidth > t.ListWidth, .Width, t.ListWidth)
    End With

End Sub

Private Sub ComboBox2_DropButtonClick()
    ComboBox1.DropDown
End Sub
\$\endgroup\$
  • \$\begingroup\$ I'm always reluctant to use Range.Offset, but I have to say that it and Resize feel "just right". Using the integer representation of the Boolean value might call for an explicit CInt conversion call, or an explanatory comment though. But I like how it removes the redundancies in the .List assignment. \$\endgroup\$ – Mathieu Guindon Sep 10 '16 at 17:26
  • \$\begingroup\$ @Mat'sMug Comments are one of my weaknesses. I liked how both of our implementations turned out. \$\endgroup\$ – user109261 Sep 10 '16 at 18:26

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.