S
Stratuser
I have a userform with two listboxes that is taking too
long to show up on the screen. The listboxes are filled
with the filenames in a subdirectory. The code works, but
it's just way too slow. Can anyone tell me what's wrong
with the code? Here it is:
Private Sub UserForm_Initialize()
'Make a list of filenames
Dim Directory As String
Dim i As Integer
Dim Listnum As Integer
Dim Item As Variant
Directory = Range("Inputsubdirectory").Value
'Fill ListBox1 with portfolios
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = Directory
.Filename = "*.xls*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
ListBox1.AddItem Dir(.FoundFiles(i)) 'Use
DIR to show only filename in listbox
Next i
End With
'Fill ListBox2 with default benchmark choices
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path & "\Benchmark Weights\"
.Filename = "*.xls*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
ListBox2.AddItem Dir(.FoundFiles(i))
Next i
End With
'Pick S&P 500 as default benchmark to highlight in
ListBox2
Listnum = -1
For Each Item In ListBox2.list
Listnum = Listnum + 1
If Item = "S&P 500.xls" Then
ListBox2.SetFocus
ListBox2.ListIndex = Listnum
Exit For
End If
Next Item
End Sub
long to show up on the screen. The listboxes are filled
with the filenames in a subdirectory. The code works, but
it's just way too slow. Can anyone tell me what's wrong
with the code? Here it is:
Private Sub UserForm_Initialize()
'Make a list of filenames
Dim Directory As String
Dim i As Integer
Dim Listnum As Integer
Dim Item As Variant
Directory = Range("Inputsubdirectory").Value
'Fill ListBox1 with portfolios
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = Directory
.Filename = "*.xls*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
ListBox1.AddItem Dir(.FoundFiles(i)) 'Use
DIR to show only filename in listbox
Next i
End With
'Fill ListBox2 with default benchmark choices
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path & "\Benchmark Weights\"
.Filename = "*.xls*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
ListBox2.AddItem Dir(.FoundFiles(i))
Next i
End With
'Pick S&P 500 as default benchmark to highlight in
ListBox2
Listnum = -1
For Each Item In ListBox2.list
Listnum = Listnum + 1
If Item = "S&P 500.xls" Then
ListBox2.SetFocus
ListBox2.ListIndex = Listnum
Exit For
End If
Next Item
End Sub