I have a UserForm that populates a number of ComboBoxes with data from a seperate workbook. The problem is that at the moment it loads and closes the workbook individually for each combobox and takes it's time about it. Is it possible for it to only open the workbook once and populate all the comboboxes at once?
The code is:
[vba]
Private Sub UserForm_Activate()
Dim sourceWB As Workbook
Dim ListItems As Variant
Dim i As Integer
Application.ScreenUpdating = False
With Me.ComboBox1
.Clear ' remove existing entries from the combobox
' open the source workbook as ReadOnly
Set sourceWB = Workbooks.Open("X:\SFCast\Admin.xls", _
False, True)
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("G5", Range("G65536").End(xlUp)).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
End With
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Me.ComboBox3
.Clear ' remove existing entries from the combobox
' open the source workbook as ReadOnly
Set sourceWB = Workbooks.Open("X:\SFCast\Admin.xls", _
False, True)
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("I5", Range("I65536").End(xlUp)).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
End With
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Me.ComboBox4
.Clear ' remove existing entries from the combobox
' open the source workbook as ReadOnly
Set sourceWB = Workbooks.Open("X:\SFCast\Admin.xls", _
False, True)
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("C5", Range("C65536").End(xlUp)).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
End With
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Me.ComboBox5
.Clear ' remove existing entries from the combobox
' open the source workbook as ReadOnly
Set sourceWB = Workbooks.Open("X:\SFCast\Admin.xls", _
False, True)
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("A5", Range("A65536").End(xlUp)).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
End With
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Me.ComboBox6
.Clear ' remove existing entries from the combobox
' open the source workbook as ReadOnly
Set sourceWB = Workbooks.Open("X:\SFCast\Admin.xls", _
False, True)
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("E5", Range("E65536").End(xlUp)).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
End With
Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Me.ComboBox7
.Clear ' remove existing entries from the combobox
' open the source workbook as ReadOnly
Set sourceWB = Workbooks.Open("X:\SFCast\Admin.xls", _
False, True)
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("F5", Range("F65536").End(xlUp)).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
End With
Application.ScreenUpdating = True
End Sub
[/vba]
Any help is much appreciated. Thank you.
Reply With Quote
Originally Posted by Johnpants
