Solved: Populate ListBox with Multiple Rows of Data

[asystole0]

Hi All, Im stuck again, need some expert advice.

I have multiple ListBoxes that need to be populated with multiple colums of data. So far I have code which only allows me to pull 1 at a time, I could just copy and paste the same code over and over but there must be an easier way than this?

Heres the code so far:


Private Sub UserForm_Initialize()
Dim ListItems As Variant, i As Integer
Dim SourceWB As Workbook
With Me.ListBox5
.Clear ' remove existing entries from the listbox
' turn screen updating off,
' prevent the user from seeing the source workbook being opened
Application.ScreenUpdating = False
' open the source workbook as ReadOnly
Set SourceWB = Workbooks.Open("\Rates\Rates.xls", _
False, True)
ListItems = SourceWB.Worksheets(1).Range("A2:A21").Value
' get the values you want
SourceWB.Close False ' close the source workbook without saving changes
Set SourceWB = Nothing
ListItems = Application.WorksheetFunction.Transpose(ListItems)
' convert values to a vertical array
For i = 1 To UBound(ListItems)
.AddItem ListItems(i) ' populate the listbox
Next i
.ListIndex = -1 ' no items selected, set to 0 to select the first item
Application.ScreenUpdating = True
End With

End Sub

[mdmackillop]

You can pass values to another routine to minimise repeated code.
Try this (untested)


Private Sub UserForm_Initialize()
Dim ListItems As Variant, i As Integer
Dim SourceWB As Workbook
Application.ScreenUpdating = False

Call FillList(Me.listbox5, "\Rates\Rates.xls", SourceWB.Worksheets(1).Range("A2:A21").Value)
'Call FillList(next set of values)
Application.ScreenUpdating = True
End Sub

Private Sub FillList(Lst As ListBox, WBook As String, ListItems As Variant)
Dim SourceWB As Workbook
With Lst
.Clear ' remove existing entries from the listbox
Set SourceWB = Workbooks.Open(WBook, False, True)
SourceWB.Close False ' close the source workbook without saving changes
Set SourceWB = Nothing
.List() = Application.WorksheetFunction.Transpose(ListItems)
.ListIndex = -1 ' no items selected, set to 0 to select the first item
End With
End Sub

[asystole0]

Thanks mdmackillop, I can see how that works, but im strugling to make it work.

Run-Time error 91
Object Variable With block variable not set.


You can pass values to another routine to minimise repeated code.
Try this (untested)


Private Sub UserForm_Initialize()
Dim ListItems As Variant, i As Integer
Dim SourceWB As Workbook
Application.ScreenUpdating = False

Call FillList(Me.listbox5, "\Rates\Rates.xls", SourceWB.Worksheets(1).Range("A2:A21").Value)
'Call FillList(next set of values)
Application.ScreenUpdating = True
End Sub

Private Sub FillList(Lst As ListBox, WBook As String, ListItems As Variant)
Dim SourceWB As Workbook
With Lst
.Clear ' remove existing entries from the listbox
Set SourceWB = Workbooks.Open(WBook, False, True)
SourceWB.Close False ' close the source workbook without saving changes
Set SourceWB = Nothing
.List() = Application.WorksheetFunction.Transpose(ListItems)
.ListIndex = -1 ' no items selected, set to 0 to select the first item
End With
End Sub

[mdmackillop]

Slightly revised ... and tested!

Private Sub UserForm_Initialize()
Dim ListItems As Variant, sh As Long

Application.ScreenUpdating = False

'Call FillList(Me.ListBoxName, Workbook Path & Name, SheetNumber, RangeAddress)

Call FillList(Me.ListBox5, "C:\Temp\Rates.xls", 1, "A1:A20")
Application.ScreenUpdating = True
End Sub

Private Sub FillList(Lst, WBook As String, Sht As Long, Rng As String)
Dim SourceWB As Workbook, ListItems
With Lst
.Clear ' remove existing entries from the listbox
Set SourceWB = Workbooks.Open(WBook, False, True)
ListItems = SourceWB.Sheets(Sht).Range(Rng).Value
SourceWB.Close False ' close the source workbook without saving changes
Set SourceWB = Nothing
.List() = Application.WorksheetFunction.Transpose(ListItems)
.ListIndex = -1 ' no items selected, set to 0 to select the first item
End With
End Sub

[asystole0]

Works Perfectly, thanks again for the help!


Slightly revised ... and tested!

Private Sub UserForm_Initialize()
Dim ListItems As Variant, sh As Long

Application.ScreenUpdating = False

'Call FillList(Me.ListBoxName, Workbook Path & Name, SheetNumber, RangeAddress)

Call FillList(Me.ListBox5, "C:\Temp\Rates.xls", 1, "A1:A20")
Application.ScreenUpdating = True
End Sub

Private Sub FillList(Lst, WBook As String, Sht As Long, Rng As String)
Dim SourceWB As Workbook, ListItems
With Lst
.Clear ' remove existing entries from the listbox
Set SourceWB = Workbooks.Open(WBook, False, True)
ListItems = SourceWB.Sheets(Sht).Range(Rng).Value
SourceWB.Close False ' close the source workbook without saving changes
Set SourceWB = Nothing
.List() = Application.WorksheetFunction.Transpose(ListItems)
.ListIndex = -1 ' no items selected, set to 0 to select the first item
End With
End Sub