PDA

View Full Version : ComboBox lag



afgg
06-10-2016, 01:06 PM
16355

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
06-10-2016, 01:15 PM
Can't think why. As a workaround, have you tried Dir to populate the combos?

Kenneth Hobs
06-10-2016, 01:26 PM
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
06-10-2016, 01:43 PM
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
06-10-2016, 01:43 PM
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
06-10-2016, 02:51 PM
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
06-10-2016, 03:21 PM
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
06-10-2016, 03:38 PM
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
06-10-2016, 04:12 PM
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
06-10-2016, 08:15 PM
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
06-10-2016, 08:18 PM
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
06-10-2016, 10:58 PM
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
06-11-2016, 03:36 AM
A similar issue here (http://www.vbaexpress.com/forum/showthread.php?56232-Excel-Userform-Listbox-VBA-Help&p=343989&viewfull=1#post343989). 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
06-11-2016, 04:41 AM
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
06-11-2016, 05:29 AM
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
06-11-2016, 01:54 PM
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
06-13-2016, 09:22 AM
I tried compiling your code, but my code is such a mess that I wasn't able to get your code to run. :(

afgg
06-13-2016, 09:37 AM
Couldn't compile your code either.

please have a look at the attach file

file was big, so i I zipped it.

16374

afgg
06-13-2016, 09:38 AM
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
06-13-2016, 09:53 AM
@ 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?

afgg
06-13-2016, 11:07 AM
@ afgg,
Who are you talking to?

to you as well as gymayor.

I thought the quick reply would tag your name as well, guess not.

afgg
06-13-2016, 11:45 AM
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

When I run your code i get the " Expected End sub" error and " Private Sub UserForm_Initialize()" gets highlighted yellow. I put an "End Sub" after these two lines


Dim IsRoof As Boolean
Dim FolderSpec As String

The code runs, but nothing works.

SamT
06-13-2016, 12:05 PM
Those two lines are not part of a sub, they are module level variables. They must stand alone above any Procedures.

Sorry, I don't see a " Private Sub UserForm_Initialize()" in my code, but if it is yellow, then it is probably missing an "End Sub." Since I don't see it in your code, I cannot comment further on it.



You do realize that I did not use your Control Names, I made up my own because the default control names do not help in any way to understand what the code is doing.

You must either:
Edit my code to fit your Control Names.
OR
Edit your Control Names to fit my code.

afgg
06-13-2016, 01:46 PM
Those two lines are not part of a sub, they are module level variables. They must stand alone above any Procedures.

Sorry, I don't see a " Private Sub UserForm_Initialize()" in my code, but if it is yellow, then it is probably missing an "End Sub." Since I don't see it in your code, I cannot comment further on it.



You do realize that I did not use your Control Names, I made up my own because the default control names do not help in any way to understand what the code is doing.

You must either:
Edit my code to fit your Control Names.
OR
Edit your Control Names to fit my code.




i get a syntax error on Function GetsubFolderNames()
This gets highlighted as well

ReDim(tmp, 1 To SubFldrs.Count)




Private Sub UserForm_Initialize()


Call FormatUserForm(Me.Caption)


'-------------------------------------
ComboBox1 = "2016" ' ComboBox1 = Year
ComboBox4 = "Floor" ' Combobox 4 = Department
With ComboBox4
.AddItem "Floor"
.AddItem "Roof"
End With
'-------------------------------------
Rlength = "5"
With Rlength ' Roof Length dropdown menu
.AddItem "2"
.AddItem "5"
.AddItem "6"
.AddItem "12"
.AddItem "14"
.AddItem "19"
.AddItem "24"
End With
'--------------------------------------


'-------------------------------------
Ohang = "1.5"
With Ohang ' overhang dropdown menu
.AddItem "1"
.AddItem "1.5"
.AddItem "2"
.AddItem "2.5"
End With
'--------------------------------------
TextBox6 = "MS" ' Initials
TextBox7 = "Productions" 'Name of Folder to be created
SLoad = "21"
Dload = "10"
'-----------------------------------------------------
End Sub

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 ComboBox1_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 ComboBox2_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 ComboBox4_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:\" & ComboBox1 & "\" & ComboBox2 & "\" & ComboBox3 & "\"
Label30 = "M:\CA\Jobs2016\" & ComboBox2
Else
Label9 = "S:\PDF_Jobs\" & ComboBox1 & "\" & ComboBox2 & "\" & ComboBox3 & "\"
End If

End Sub

afgg
06-13-2016, 01:59 PM
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



I got your code compiled but it is no hope while loading that one folder. it still takes about 10 seconds to load that folder.

p45cal
06-13-2016, 02:04 PM
afgg, tell me about combobox1, the one labelled Year/Folder; At one stage you say ComboBox1 = "2016", is this 2016 the name of one of the folders in there and if not why is it there?

afgg
06-13-2016, 02:27 PM
afgg, tell me about combobox1, the one labelled Year/Folder; At one stage you say ComboBox1 = "2016", is this 2016 the name of one of the folders in there and if not why is it there?

yes, 2016 is a folder in there. I just wanted to have 2016 as default when I opened up the userform.

mdmackillop
06-13-2016, 02:42 PM
Use Option Explicit to identify issues.

Wrong syntax

ReDim Tmp(1 To SubFldrs.Count)

and typo in SubFldrs/SubFlders


Set SubFldrs = Fldr.SubFolders

ReDim(tmp, 1 To SubFldrs.Count)

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



FSO/fs

Set FSO = CreateObject("Scripting.FileSystemObject") Set Fldr = fs.getfolder(FolderSpec)

snb
06-14-2016, 01:14 AM
Reduce your Initialize code to:


Private Sub UserForm_Initialize()
ComboBox1.lidst=split("2016")
ComboBox4.list = split("Floor Roof")
Rlength.list= split("2 5 6 12 14 19 24")
Ohang.list= split("1 1.5 2 2.5")
End Sub

These property values should be entered in Design Mode:

TextBox6.Text = "MS"
TextBox7.Text = "Productions"
SLoad.Text = "21"
Dload.Text = "10"

PS. Do not hesitate to master the fundamentals of VBA before using it:
Excel VBA Programming For Dummies by John Walkenbach | 9781119077398 | Paperback | Barnes & Noble (http://www.barnesandnoble.com/w/excel-vba-programming-for-dummies-john-walkenbach/1101874584)

A forum is no substitute for a VBA course nor a VBA book.

Do not copy/use VBA Code you do not fully understand.

afgg
06-14-2016, 09:06 AM
Reduce your Initialize code to:


Private Sub UserForm_Initialize()
ComboBox1.lidst=split("2016")
ComboBox4.list = split("Floor Roof")
Rlength.list= split("2 5 6 12 14 19 24")
Ohang.list= split("1 1.5 2 2.5")
End Sub

These property values should be entered in Design Mode:

TextBox6.Text = "MS"
TextBox7.Text = "Productions"
SLoad.Text = "21"
Dload.Text = "10"

PS. Do not hesitate to master the fundamentals of VBA before using it:
Excel VBA Programming For Dummies by John Walkenbach | 9781119077398 | Paperback | Barnes & Noble (http://www.barnesandnoble.com/w/excel-vba-programming-for-dummies-john-walkenbach/1101874584)

A forum is no substitute for a VBA course nor a VBA book.

Do not copy/use VBA Code you do not fully understand.

do you think that is affecting my problem or that is just cleaner code.

What difference would it make in design mode?

afgg
06-14-2016, 09:09 AM
Use Option Explicit to identify issues.

Wrong syntax

ReDim Tmp(1 To SubFldrs.Count)

and typo in SubFldrs/SubFlders


Set SubFldrs = Fldr.SubFolders

ReDim(tmp, 1 To SubFldrs.Count)

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



FSO/fs

Set FSO = CreateObject("Scripting.FileSystemObject") Set Fldr = fs.getfolder(FolderSpec)


I don't see anything different than the original code.

snb
06-14-2016, 09:26 AM
Please do not quote !

Please test the suggestions you have been given and report the results meticulously.

afgg
06-14-2016, 11:14 AM
I have tested those suggestions and they all seem to work the same. I couldn't compile SamT's code because of a syntax error and I am not good enough to figure out why.

mdmackillop
06-14-2016, 12:24 PM
Please post the relevant lines.

afgg
06-14-2016, 01:36 PM
@mdmackillop, you said those code lines are wrong, but when I matched it with his codes, they are they same. Did you just point out the mistake without correcting it?

mdmackillop
06-14-2016, 01:42 PM
Did you just point out the mistake without correcting it?
Yes

afgg
06-15-2016, 01:05 PM
Yes

okay thanks! I see the changes now! dumb me.

So I got samT's code compiled finally but when I run it, My "Wrong year" message pops up straight away nothing else. :/

when I debug, this line gets highlighted

Set Fldr = fs.getfolder(folderspec)

when I hover over it , it says "folderspec = empty"

SamT
06-15-2016, 06:10 PM
I commented this to show what the code is doing. Basically you are selecting items in a control then adding more items with the same value as the selected item.

Private Sub UserForm_Initialize()


Call FormatUserForm(Me.Caption)


'-------------------------------------
'Select item 2026 from Combobox1 list
ComboBox1 = "2016" ' ComboBox1 = Year
'Select item Floor from combobox4 list
ComboBox4 = "Floor" ' Combobox 4 = Department
Add Items Floor and roof to combobox4.List
With ComboBox4
.AddItem "Floor"
.AddItem "Roof"
End With
'-------------------------------------
'''''''''''What is an "Rlength"? A listBox? A Variable?
'Select Item "5" from listbox list
Rlength = "5"
With Rlength ' Roof Length dropdown menu
'Add items 2, 5, 6, etc to listbox.List
.AddItem "2"
.AddItem "5"
.
.
.
.

SamT
06-15-2016, 06:39 PM
I made a little "How to name controls" UserForm for you.

Here is the code. It runs without error. But I put in two mistakes. Can you see them?

What Type controls did I use?


Enum Sheet1ColNumbers
s1colApplicationNumber = 1 'Only the first must be set if it is other than zero
s1colName 'all the rest auto increment by 1
s1colAge
s1colSex
End Enum


Private Sub cbtSave_Click()
Dim NR As Long 'NextRow

With Sheets("Sheet2")
NR = .Cells(Rows.Count, s1colApplicationNumber).End(xlUp).Row + 1

With .Rows(NR)
.Cells(s1colApplicationNumber) = lblApplicationNumber
.Cells(s1colName) = tbxName
.Cells(s1colAge) = tbxSex
.Cells(s1colSex) = tbxAge
End With
End With

End Sub

Don't look until you've found the two errors.

In the attached is the actual UserForm. Use the VBA Properties Window to see the names of all the controls and note which ones I did not edit.

Just click on one control to bring it up in the Property window. You can also use the Window's Drop Down list.