ComboBox lag

[afgg]

Capture.jpg

I am having a weird lagging problem with my comboBoxes. There is a folder in ComboBox2("company") that is about 15GB and when I select that, It takes about 10 seconds to load. I noticed that If the folder is populated to the other two comboboxes, it doesn't lag there for some reason. It is ****ing me off and I can't find a way around it

Is there a way to get rid of my lagging problem on comboBox2?

Private Sub ComboBox1_Change()    Dim fs, f, f1, fc, s
    Dim folderspec
    'Combobox4 Roof
    If ComboBox4 = "Roof" Then
    folderspec = "M:\CA\"
    Else
    folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\"
    End If
   
   On Error GoTo er:
   
    'folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\"    ' change you your folder address


    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders


    ComboBox2.Clear


    For Each f1 In fc


        ComboBox2.AddItem f1.Name
      


    Next f1
    Exit Sub
er:     MsgBox " Wrong Year?"
End Sub


Private Sub ComboBox2_Change() 'company combobox
    Dim fs, f, f1, fc, s
    Dim folderspec
    
    'Combobox4 Roof
    If ComboBox4 = "Roof" Then
    folderspec = "M:\CA\" & ComboBox2
    Else
    folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\" & ComboBox2 & "\"
    End If
    
    On Error GoTo er:


    'folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\" & ComboBox2 & "\"  ' change you your folder address


    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders


    ComboBox3.Clear


    For Each f1 In fc
    
        ComboBox3.AddItem f1.Name
       


       
    Next f1
Exit Sub
er:      MsgBox "Typo or Company not Found"
End Sub


Private Sub ComboBox4_Change()
    Dim fs, f, f1, fc, s
    Dim folderspec
    
'Combobox4 = Department
    
    If ComboBox4 = "Roof" Then
    folderspec = "M:\"
    Else
    folderspec = "S:\PDF_Jobs\"
    End If
   
    'folderspec = "M:\CA\"    ' change you your folder address


    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders


    ComboBox1.Clear


    For Each f1 In fc


       ComboBox1.AddItem f1.Name
      


    Next f1
   
End Sub


Private Sub ComboBox3_Change()
If ComboBox4 = "Roof" Then
Label9 = "M:\" & ComboBox1 & "\" & ComboBox2 & "\" & ComboBox3 & "\"
Else
Label9 = "S:\PDF_Jobs\" & ComboBox1 & "\" & ComboBox2 & "\" & ComboBox3 & "\"
End If
If ComboBox4 = "Roof" Then
Label30 = "M:\CA\Jobs2016\" & ComboBox2
End If




End Sub

[mdmackillop]

Can't think why. As a workaround, have you tried Dir to populate the combos?

[Kenneth Hobs]

I guess it is because every time that you Add an item, it fires that Controls Change event. Try using a routine that adds all items at once.

[afgg]

Can't think why. As a workaround, have you tried Dir to populate the combos?

Isn't it getting populated by Dir right now?

Sorry, I am a newbie, can you perhaps guide me?

[afgg]

I guess it is because every time that you Add an item, it fires that Controls Change event. Try using a routine that adds all items at once.

Can you help me out here? I a newbie.

[mdmackillop]

Based on Kenneth's observation, modify your code as follows and similarly for other combos. It adds all subfolders to the list in one action

Private Sub ComboBox1_Change()
    Dim fs, f, f1, fc, s, i As Long
    Dim folderspec
    Dim arr()
    'Combobox4 Roof
    If ComboBox4 = "Roof" Then
        folderspec = "M:\CA\"
    Else
        folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\"
    End If
    On Error GoTo er:
    'folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\"    ' change you your folder address
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders
    ComboBox2.Clear
    'Create an array of folder names
    ReDim arr(fc.Count - 1)
    For Each f1 In fc
        arr(i) = f1.Name
        i = i + 1
    Next f1
    'Add list to combo
    ComboBox2.List = arr
    Exit Sub
er:     MsgBox " Wrong Year?"
End Sub

[afgg]

Thanks for helping me out, but I tried your code with no result

Private Sub ComboBox1_Change()    Dim fs, f, f1, fc, s, i As Long
    Dim folderspec
    Dim arr()
     'Combobox4 Roof
    If ComboBox4 = "Roof" Then
        folderspec = "M:\CA\"
    Else
        folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\"
    End If
On Error GoTo er:
     'folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\"    ' change you your folder address
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders
    ComboBox2.Clear
     'Create an array of folder names
    ReDim arr(fc.Count - 1)
    For Each f1 In fc
        arr(i) = f1.Name
        i = i + 1
    Next f1
     'Add list to combo
    ComboBox2.List = arr
    Exit Sub
er:         MsgBox " Wrong Year?"
End Sub




Private Sub ComboBox2_Change() 'company combobox
    Dim fs, f, f1, fc, s, i As Long
    Dim folderspec
    Dim arr()
    'Combobox4 Roof
    If ComboBox4 = "Roof" Then
    folderspec = "M:\CA\" & ComboBox2
    Else
    folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\" & ComboBox2 & "\"
    End If
    
    On Error GoTo er:


    'folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\" & ComboBox2 & "\"  ' change you your folder address


    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders


    ComboBox3.Clear
    ReDim arr(fc.Count - 1)
    For Each f1 In fc
    arr(i) = f1.Name
    i = i + 1
    Next f1
    'Add list to combo
        ComboBox3.List = arr
    
Exit Sub
er:      MsgBox "Typo or Company not Found"
End Sub


Private Sub ComboBox4_Change()
    Dim fs, f, f1, fc, s, i As Long
    Dim folderspec
    Dim arr()
'Combobox4 = Department
    
    If ComboBox4 = "Roof" Then
    folderspec = "M:\"
    Else
    folderspec = "S:\PDF_Jobs\"
    End If
   
    'folderspec = "M:\CA\"    ' change you your folder address


    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders


    ComboBox1.Clear
    ReDim arr(fc.Count - 1)
    For Each f1 In fc
    i = i + 1
    Next f1
       ComboBox1.List = arr
   
End Sub


Private Sub ComboBox3_Change()
If ComboBox4 = "Roof" Then
Label9 = "M:\" & ComboBox1 & "\" & ComboBox2 & "\" & ComboBox3 & "\"
Else
Label9 = "S:\PDF_Jobs\" & ComboBox1 & "\" & ComboBox2 & "\" & ComboBox3 & "\"
End If
If ComboBox4 = "Roof" Then
Label30 = "M:\CA\Jobs2016\" & ComboBox2
End If




End Sub

[mdmackillop]

Here's my simpler testing code. Try it in a userform with ComboBox1. It should list your C: drive folders.

Private Sub UserForm_Activate()
test
End Sub


Private Sub test()
    Dim fs, f, f1, fc, s, i As Long
    Dim folderspec
    Dim arr()
    On Error GoTo er:
    folderspec = "C:\"    ' change you your folder address
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders
    ComboBox1.Clear
    'Create an array of folder names
    ReDim arr(fc.Count - 1)
    For Each f1 In fc
        arr(i) = f1.Name
        i = i + 1
    Next f1
    'Add list to combo
    ComboBox1.List = arr
    Exit Sub
er:     MsgBox " Wrong Year?"
End Sub

[p45cal]

In addition to the above advice, it looks as though the cascading effect might be being overused; for example, if you change combobox4, that causes combobox1 to repopulate, if this repopulation counts as a combobox1_change event then that fires, which in turn repopulates combobox2, which fires its own change event which repopulates combobox3. I realise that this is by design, however, repopulation might be taking place more often than necessary: The combobox1_change event always looks at combobox4 and regardless of its value always repopulates combobox2. If combobox4 was Roof before, and it hasn't changed, perhaps there's no reason to repopulate combobox2?
When comboboxes get repopulated, what's their value straight after that process? Blank? What's the next combobox down the line populated with when that happens? Perhaps the combobox next down the line only needs to be cleared rather than repopulated when that happens?
Also, and this may be important, the combobox2_change event code is the only one where the line:
folderspec = "M:\CA\" & ComboBox2
is not followed by:
& "\"

Perhaps supply a trimmed down version of your file with only the userform and its code in, here, and we can substitute our own values for the paths in the code so (a) we can experiment and (b) we don't have to guess (wrongly) things about your userform. (Also, how many choices are there in combobox4 typically?)

[afgg]

Here's my simpler testing code. Try it in a userform with ComboBox1. It should list your C: drive folders.

Private Sub UserForm_Activate()
test
End Sub


Private Sub test()
    Dim fs, f, f1, fc, s, i As Long
    Dim folderspec
    Dim arr()
    On Error GoTo er:
    folderspec = "C:\"    ' change you your folder address
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.getfolder(folderspec)
    Set fc = f.subfolders
    ComboBox1.Clear
    'Create an array of folder names
    ReDim arr(fc.Count - 1)
    For Each f1 In fc
        arr(i) = f1.Name
        i = i + 1
    Next f1
    'Add list to combo
    ComboBox1.List = arr
    Exit Sub
er:     MsgBox " Wrong Year?"
End Sub

hm.. that works with C:\ so I don't see why my code can't handle a 15GB folder?
Every other folder works perfectly except that one huge folder.

[afgg]

In addition to the above advice, it looks as though the cascading effect might be being overused; for example, if you change combobox4, that causes combobox1 to repopulate, if this repopulation counts as a combobox1_change event then that fires, which in turn repopulates combobox2, which fires its own change event which repopulates combobox3. I realise that this is by design, however, repopulation might be taking place more often than necessary: The combobox1_change event always looks at combobox4 and regardless of its value always repopulates combobox2. If combobox4 was Roof before, and it hasn't changed, perhaps there's no reason to repopulate combobox2?
When comboboxes get repopulated, what's their value straight after that process? Blank? What's the next combobox down the line populated with when that happens? Perhaps the combobox next down the line only needs to be cleared rather than repopulated when that happens?
Also, and this may be important, the combobox2_change event code is the only one where the line:
folderspec = "M:\CA\" & ComboBox2
is not followed by:
& "\"

Perhaps supply a trimmed down version of your file with only the userform and its code in, here, and we can substitute our own values for the paths in the code so (a) we can experiment and (b) we don't have to guess (wrongly) things about your userform. (Also, how many choices are there in combobox4 typically?)

perhaps that could be it. If I add application.enableevents = False, where would i insert that code to stop the whole thing from firing up.


but as I explained earlier, only that one folder is acting up like that. I will attach the file when I get to work on monday.
ComboBox has two choice: roof & Floor

[gmayor]

Having looked briefly at your code I have to agree with p45Cal. The four combo-boxes are totally dependent on one another and any change to one (such as adding each individual folder name to a list) ripples through and causes each of the other comboboxes to repopulate. It turns into a monster. I would suggest introducing some error handling to prevent unwanted repopulation and abbreviating your code makes it much more difficult to follow and gains nothing in speed so something like the following may be nearer the mark?

Option Explicit

Private fs As Object
Private f As Object
Private f1 As Object
Private fc As Object
Private folderspec As String

Private Sub ComboBox1_Change()

    With Me
        If .ComboBox1.ListIndex = -1 Then Exit Sub
        If .ComboBox4.ListIndex = -1 Then Exit Sub
        If .ComboBox4.Text = "Roof" Then
            folderspec = "M:\CA\"
        Else
            folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\"
        End If
        Set fs = CreateObject("Scripting.FileSystemObject")
        If Not (fs.FolderExists(folderspec)) Then
            MsgBox "The folder " & folderspec & " is not found"
            Exit Sub
        End If
        Set f = fs.getfolder(folderspec)
        Set fc = f.subfolders
        .ComboBox2.Clear
        For Each f1 In fc
            .ComboBox2.AddItem f1.Name
        Next f1
        .ComboBox2.ListIndex = -1
    End With
    Set fs = Nothing
    Set f = Nothing
    Set f1 = Nothing
    Set fc = Nothing
End Sub

Private Sub ComboBox2_Change()    'company combobox
    With Me
        If .ComboBox2.ListIndex = -1 Then Exit Sub
        If .ComboBox1.ListIndex = -1 Then Exit Sub
        If .ComboBox4.ListIndex = -1 Then Exit Sub
        
        If ComboBox4 = "Roof" Then
            folderspec = "M:\CA\" & .ComboBox2.Text
        Else
            folderspec = "S:\PDF_Jobs\" & .ComboBox1.Text & "\" & .ComboBox2.Text & "\"
        End If

        Set fs = CreateObject("Scripting.FileSystemObject")
        If Not (fs.FolderExists(folderspec)) Then
            MsgBox "The folder " & folderspec & " is not found"
            Exit Sub
        End If
        
        Set f = fs.getfolder(folderspec)
        Set fc = f.subfolders

        .ComboBox3.Clear
        For Each f1 In fc
            .ComboBox3.AddItem f1.Name
        Next f1
    End With
    Set fs = Nothing
    Set f = Nothing
    Set f1 = Nothing
    Set fc = Nothing
End Sub
Private Sub ComboBox4_Change()
    With Me
        If .ComboBox4.ListIndex = -1 Then Exit Sub
        If .ComboBox4.Text = "Roof" Then
            folderspec = "M:\"
            .ComboBox1.ListIndex = -1
            .ComboBox2.ListIndex = -1
            .ComboBox3.ListIndex = -1
        Else
            folderspec = "S:\PDF_Jobs\"
            .ComboBox1.ListIndex = -1
            .ComboBox2.ListIndex = -1
            .ComboBox3.ListIndex = -1
        End If
        Set fs = CreateObject("Scripting.FileSystemObject")
        If Not (fs.FolderExists(folderspec)) Then
            MsgBox "The folder " & folderspec & " is not found"
            Exit Sub
        End If
        Set f = fs.getfolder(folderspec)
        Set fc = f.subfolders
        .ComboBox1.Clear
        For Each f1 In fc
            .ComboBox1.AddItem f1.Name
        Next f1
    End With
    Set fs = Nothing
    Set f = Nothing
    Set f1 = Nothing
    Set fc = Nothing
End Sub

Private Sub ComboBox3_Change()
    With Me
        If .ComboBox3.ListIndex = -1 Then Exit Sub
        If .ComboBox4.ListIndex = -1 Then Exit Sub
        If .ComboBox2.ListIndex = -1 Then Exit Sub
        If .ComboBox1.ListIndex = -1 Then Exit Sub
        .Label9.Caption = ""
        .Label30.Caption = ""
        If .ComboBox4.Text = "Roof" Then
            .Label9.Caption = "M:\" & .ComboBox1.Text & "\" & .ComboBox2.Text & "\" & .ComboBox3.Text & "\"
        Else
            .Label9.Caption = "S:\PDF_Jobs\" & .ComboBox1.Text & "\" & .ComboBox2.Text & "\" & .ComboBox3.Text & "\"
        End If
        If .ComboBox4.Text = "Roof" Then
            .Label30.Caption = "M:\CA\Jobs2016\" & .ComboBox2.Text
        End If
    End With
End Sub

Private Sub UserForm_Initialize()
    With Me.ComboBox4
        .AddItem "Roof"
        .AddItem "Floor"
        .ListIndex = -1
    End With
End Sub

[mdmackillop]

A similar issue here. I added Disable as a variable to prevent the full event code from running. EnableEvents = False does not appear to work on Combobox/Listbox actions

[p45cal]

perhaps that could be it. If I add application.enableevents = False, where would i insert that code to stop the whole thing from firing up.
but as I explained earlier, only that one folder is acting up like that. I will attach the file when I get to work on monday.

Application.EnableEvents doesn't apply to controls on a userform but you can easily code the equivalent while having much finer control over what code runs and when along the lines of http://www.cpearson.com/excel/SuppressChangeInForms.htm.

I'll await your file on Monday before doing any more.

[snb]

To avoid 'firing' ActiveX/userform controls:

Private sub Combobox1_change()
  if combobox1.tag="" then x=12
end sub

Private sub combobox2_change()
   combobox1.tag=" "
   combobox1.listindex=combobox2.listindex
   combobox1.tag=""
End Sub

To populate a listbox/combobox, see:

http://www.snb-vba.eu/VBA_Fill_combobox_listbox_en.html

[SamT]

Since your code only indicates the purposes of ComboBoxes 2 and 4, (Company and Department,) I can only speculate about the sequence of events your Users must go thru
Select a Year/Folder. (Dependent on "Roof") Changes Company List
Select a Company. (Dependent on "Roof") Changes Department List
Select a Department. (Dependent on "Roof") Changes Year/Folder List and Sets "Roof"
Repeat until possible choices quit changing.
Select from Combobox3.

I suggest that you start the User Experience from your ComboBox4, (My cboDepartment) And forget changing the list in it after the first selection since it itself and two of the other cbo Boxes are dependent on it.

Dim IsRoof As Boolean
Dim FolderSpec As String

Function GetsubFolderNames() As Variant
Dim FSO as Object
Dim Fldr As Variant
Dim SubFldrs As Variant
Dim i As Long
Dim Tmp As Variant

   Set FSO = CreateObject("Scripting.FileSystemObject") 
   Set Fldr = fs.getfolder(folderspec)
   Set SubFldrs = Fldr.SubFolders 

ReDim(tmp, 1 to SubFldrs.Count)

For i = 1 to UBound(Tmp)
Tmp(i)= SubFlders(i).Name
Next

Set FSO = Nothing
Set Fldr = Nothing
Set SubFldrs = Nothing

GetSubFolderNames = Tmp
End Function

Private Sub cboYear_Change() 
'ComboBox1
    If IsRoof Then 'IsRoof will be false until the Roof department is later selected
        folderspec = "M:\CA\" 
    Else 
        folderspec = "S:\PDF_Jobs\" & ComboBox1 & "\" 
    End If 
     
On Error GoTo er: 
    cboComapny.List = GetSubFolderNames 
  
    Exit Sub 
    er:     MsgBox " Wrong Year?" 
End Sub

Private Sub cboCompany_Change() 
'company combobox
     
    If IsRoof Then 'IsRoof will be false until the Roof department is later selected
        folderspec = "M:\CA\" & cboCompapny 
    Else 
        folderspec = "S:\PDF_Jobs\" & cboYear & "\" & cboCompany & "\" 
    End If 
     
On Error GoTo er: 
     
    ComboBox3.List = GetSubFolderNames
 
    Exit Sub 
    er:      MsgBox "Typo or Company not Found" 
End Sub

Private Sub cboDepartment_Change() 
     'Combobox4 = Department
    'This is where IsRoof might become True
     
    IsRoof = ComboBox4 = "Roof" 
    
    If IsRoof Then    
        folderspec = "M:\" 
    Else 
        folderspec = "S:\PDF_Jobs\" 
    End If 
          
    cboYear.List=GetSubFolderNames
     
End Sub

Private Sub ComboBox3_Change() 
    If IsRoof Then 
        Label9 = "M:\" & cboYear & "\" & cboCompany & "\" & ComboBox3 & "\" 
        Label30 = "M:\CA\Jobs2016\" & cboCompany 
    Else 
        Label9 = "S:\PDF_Jobs\" & cboYear & "\" & cboCompany & "\" & ComboBox3 & "\" 
    End If 

End Sub

[afgg]

I tried compiling your code, but my code is such a mess that I wasn't able to get your code to run.

[afgg]

Couldn't compile your code either.

please have a look at the attach file

file was big, so i I zipped it.

Test.zip

[afgg]

I tried your code again and changed the path to M:\CA:\Jobs2016(this is the folder that i am having problems with) and it still lagged with that path.

[SamT]

@ afgg,

I tried compiling your code,

Couldn't compile your code either.

I tried your code again and changed the path

Who are you talking to?