PDA

View Full Version : Solved: Reducing Userform Load Time



Johnpants
11-10-2005, 04:42 AM
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:


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


Any help is much appreciated. Thank you.

Bob Phillips
11-10-2005, 04:55 AM
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?


Private Sub UserForm_Activate()
Dim sourceWB As Workbook
Dim ListItems As Variant
Dim i As Integer

Application.ScreenUpdating = False
' open the source workbook as ReadOnly
Set sourceWB = Workbooks.Open("X:\SFCast\Admin.xls", _
False, True)

With Me.ComboBox1
.Clear ' remove existing entries from the combobox
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("G5", Range("G65536").End(xlUp)).Value
' get the values you want
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

With Me.ComboBox3
.Clear ' remove existing entries from the combobox
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("I5", Range("I65536").End(xlUp)).Value
' get the values you want
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

With Me.ComboBox4
.Clear ' remove existing entries from the combobox
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("C5", Range("C65536").End(xlUp)).Value
' get the values you want
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

With Me.ComboBox5
.Clear ' remove existing entries from the combobox
ListItems = sourceWB.Worksheets(1).Range("A5", Range("A65536").End(xlUp)).Value
' get the values you want
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

With Me.ComboBox6
.Clear ' remove existing entries from the combobox
'no need to use all rows if empty
ListItems = sourceWB.Worksheets(1).Range("E5", Range("E65536").End(xlUp)).Value
' get the values you want
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

With Me.ComboBox7
.Clear ' remove existing entries from the combobox
ListItems = sourceWB.Worksheets(1).Range("F5", Range("F65536").End(xlUp)).Value
' get the values you want
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

sourceWB.Close False ' close the source workbook without saving changes
Set sourceWB = Nothing
Application.ScreenUpdating = True
End Sub

Johnpants
11-10-2005, 05:03 AM
Perfect, much appreciated xld. :)