View Full Version : ComboBox lag
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.
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?
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
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?)
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.
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.
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
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
I tried compiling your code, but my code is such a mess that I wasn't able to get your code to run. :(
Couldn't compile your code either.
please have a look at the attach file
file was big, so i I zipped it.
16374
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.
@ 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,
Who are you talking to?
to you as well as gymayor.
I thought the quick reply would tag your name as well, guess not.
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.
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.
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
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, 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)
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.
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?
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.
Please do not quote !
Please test the suggestions you have been given and report the results meticulously.
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.
@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
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"
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"
.
.
.
.
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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.