Microsoft Office Forums - View Single Post - [Solved] UserForm Dropdown List Not Populating

gmayor · 04-05-2016, 04:47 AM

Actually you are doing nothing wrong. The error was mine. The code has lost a line

I'll fix it on the web site, but in the meantime, I have corrected it below.

The userform primarily needs code to set a Tag of 0 for cancel and 1 for proceeding associated with the command buttons and in both cases to hide the form e.g.

Code:

Option Explicit

Private Sub btnOK_Click()
Me.Hide
Me.Tag = 1
End Sub

Private Sub btnCancel_Click()
Me.Hide
Me.Tag = 0
End Sub

The processing then all takes place in the main macro. The code goes in an ordinary module.

Code:

Option Explicit

Private RS As Object
Private CN As Object
Private numrecs As Long, q As Long
Private strWidth As String

Sub Main()
Dim oFrm As New DrawingNumberEntryForm
    With oFrm
        xlFillList ListOrComboBox:=.DrawingNumberUf, _
                   iColumn:=1, _
                   strWorkbook:="C:\Temp\ItemSheet.xlsx", _
                   strRange:="CollRange", _
                   RangeIsWorksheet:=False, _
                   RangeIncludesHeaderRow:=True
        .Show
        If .Tag = 0 Then GoTo lbl_Exit
        'Do stuff with ofrm
    End With
lbl_Exit:
    Unload oFrm
    Set oFrm = Nothing
    Exit Sub
End Sub

Private Function xlFillList(ListOrComboBox As Object, _
                            iColumn As Long, _
                            strWorkbook As String, _
                            strRange As String, _
                            RangeIsWorksheet As Boolean, _
                            RangeIncludesHeaderRow As Boolean, _
                            Optional PromptText As String = "[Select Item]")


    If RangeIsWorksheet = True Then
        strRange = strRange & "$]"
    Else
        strRange = strRange & "]"
    End If

    Set CN = CreateObject("ADODB.Connection")


    If RangeIncludesHeaderRow Then
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    Else
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
    End If


    Set RS = CreateObject("ADODB.Recordset")
    RS.CursorLocation = 3

    RS.Open "SELECT * FROM [" & strRange, CN, 2, 1    'read the data from the worksheet

    With RS
        .MoveLast
        numrecs = .RecordCount
        .MoveFirst
    End With

    With ListOrComboBox
        .ColumnCount = RS.Fields.Count
        If RS.RecordCount > 0 Then
            .Column = RS.GetRows(numrecs)
        End If

        strWidth = vbNullString
        For q = 1 To .ColumnCount
            If q = iColumn Then
                If strWidth = vbNullString Then
                    strWidth = .Width - 4 & " pt"
                Else
                    strWidth = strWidth & .Width - 4 & " pt"
                End If
            Else
                strWidth = strWidth & "0 pt"
            End If
            If q < .ColumnCount Then
                strWidth = strWidth & ";"
            End If
        Next q
        .ColumnWidths = strWidth
        If TypeName(ListOrComboBox) = "ComboBox" Then
            .AddItem PromptText, 0
            If Not iColumn - 1 = 0 Then .Column(iColumn - 1, 0) = PromptText
            .ListIndex = 0
        End If
    End With

    'Cleanup
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing

lbl_Exit:
    Exit Function
End Function