Consulting

Results 1 to 5 of 5

Thread: Solved: Populate ListBox with Multiple Rows of Data

  1. #1
    VBAX Regular
    Joined
    Apr 2010
    Location
    Cheltenham
    Posts
    32
    Location

    Solved: Populate ListBox with Multiple Rows of Data

    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:

    [VBA]
    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
    [/VBA]

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    You can pass values to another routine to minimise repeated code.
    Try this (untested)

    [VBA]
    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

    [/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    VBAX Regular
    Joined
    Apr 2010
    Location
    Cheltenham
    Posts
    32
    Location
    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.

    Quote Originally Posted by mdmackillop
    You can pass values to another routine to minimise repeated code.
    Try this (untested)

    [vba]
    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

    [/vba]

  4. #4
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Slightly revised ... and tested!
    [vba]
    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

    [/vba]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  5. #5
    VBAX Regular
    Joined
    Apr 2010
    Location
    Cheltenham
    Posts
    32
    Location
    Works Perfectly, thanks again for the help!

    Quote Originally Posted by mdmackillop
    Slightly revised ... and tested!
    [vba]
    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

    [/vba]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •