excel - Array/Collection not inserting values into cbo on custom userform -
i have read article doug glancy creating flexible chooser form. utilizing code , previous worked code trying dynamically read list of strings, insert them collection , pass collection values chosen in custom combo box. although, not show in combo box when have correct spreadsheet open. below code wrote.
doug glancy's article: http://yoursumbuddy.com/a-flexible-vba-chooser-form/
this code used in module:
'========================================================================================================================== 'filename: modvulnerabilityreport 'description: module contain functions analyze list of vulnerabilities outputted vulnerability ' remediation asset manager (vram) systems @ site. utilizing built-in worksheet functions, output ' calculation of number of vulnerabilities per category displayed in message box. 'concept taken from: doug glancy 'originally written by: doug glancy, zack barresse 'modified by: troy pilewski 'date: 2015-03-31 '========================================================================================================================== option explicit function getchoicefromchooserform(strchoices() string, strcaption string) string '========================================================================================================================== 'description: function populate combo box on userform , return answer 'originally written by: doug glancy 'modified by: troy pilewski 'date: 2015-03-31 '========================================================================================================================== 'declare local variables dim ufchooser frmchooser dim strchoicestopass() string redim strchoicestopass(lbound(strchoices) ubound(strchoices)) strchoicestopass() = strchoices() 'initializes new userform of frmchooser set ufchooser = new frmchooser ufchooser .caption = strcaption .choicelist = strchoicestopass .show if .closedwithok getchoicefromchooserform = .choicevalue end if unload ufchooser end end function sub showtotalvulnerabilties() '========================================================================================================================== 'description: procedure calculate sum total of vulnerabilities per asset each category based on owner selection 'originally written by: troy pilewski 'date: 2015-03-31 '========================================================================================================================== 'declare local variables dim wsdata worksheet dim rngdata range, rngwhole range, colowner range, colcategory range, colsummary range dim strowner string dim lngowner long, lngcategory long, lngsummary long dim lnglastrow long, lngownerrow long dim lngcountcategoryi long, lngcountcategoryii long, lngcountcategoryiii long, lngcountcategoryiv long dim vntowners() variant, owners collection, strownernames() string, long 'sets datasheet active worksheet if activesheet nothing exit sub end if set wsdata = activesheet 'turn off application events speed code call toggleevents(false) 'determine last row values lnglastrow = wsdata.range("a:j").find( _ what:="*", _ after:=wsdata.range("a1"), _ lookat:=xlbyrows, _ searchorder:=xlbyrows, _ searchdirection:=xlprevious _ ).row 'set working ranges set rngwhole = wsdata.range("a2:j" & lnglastrow) set rngdata = wsdata.range("a3:j" & lnglastrow) 'determines column numbers criteria columns lngowner = wsdata.range("a:j").find( _ what:="owner", _ after:=wsdata.range("a1"), _ lookat:=xlpart, _ searchorder:=xlbycolumns, _ searchdirection:=xlnext _ ).column lngcategory = wsdata.range("a:j").find( _ what:="cat", _ after:=wsdata.range("a1"), _ lookat:=xlpart, _ searchorder:=xlbycolumns, _ searchdirection:=xlnext _ ).column lngsummary = wsdata.range("a:j").find( _ what:="not compliant", _ after:=wsdata.range("a1"), _ lookat:=xlpart, _ searchorder:=xlbycolumns, _ searchdirection:=xlnext _ ).column 'creates , adds each owner collection vntowners = wsdata.range("a3:a" & lnglastrow).value set owners = new collection 'loop through array of owner values (duplicates in list) lngownerrow = lbound(vntowners, 1) ubound(vntowners, 1) 'check first unique value of owner if keyisincollection(owners, cstr(vntowners(lngownerrow, 1))) = false 'add first unique owner collection owners.add cstr(vntowners(lngownerrow, 1)), cstr(vntowners(lngownerrow, 1)) end if next lngownerrow 'converts collection string owners redim strownernames(.count) string = 1 .count strownernames(i) = .item(i) next end 'assigns column number variable rngwhole set colowner = .columns(lngowner) set colcategory = .columns(lngcategory) set colsummary = .columns(lngsummary) 'prompts user select vulnerability owner strowner = getchoicefromchooserform(strownernames, "owner selection") 'validates owner selected if strowner = vbnullstring exit sub end if 'calculate sum of vulnerabilities owner , category lngcountcategoryi = worksheetfunction.sumifs(colsummary, colowner, strowner, colcategory, "i") lngcountcategoryii = worksheetfunction.sumifs(colsummary, colowner, strowner, colcategory, "ii") lngcountcategoryiii = worksheetfunction.sumifs(colsummary, colowner, strowner, colcategory, "iii") lngcountcategoryiv = worksheetfunction.sumifs(colsummary, colowner, strowner, colcategory, "iv") 'displays message box results msgbox title:="vulnerability totals", _ prompt:="the total number of " & strowner & " vulnerabilities each category are:" & vbcrlf & _ "category : " & lngcountcategoryi & vbcrlf & _ "category ii : " & lngcountcategoryii & vbcrlf & _ "category iii: " & lngcountcategoryiii & vbcrlf & _ "category iv : " & lngcountcategoryiv end end sub sub toggleevents(blnstate boolean) '========================================================================================================================== 'description: toggles application events boolean state 'originally written by: zack barresse 'date: 2014-09-15 '========================================================================================================================== application.displayalerts = blnstate application.enableevents = blnstate application.screenupdating = blnstate if blnstate application.cutcopymode = false if blnstate application.statusbar = false end sub public function keyisincollection(colltemp collection, keytocheck string) boolean '========================================================================================================================== 'description: validates selection not in collection 'originally written by: zack barresse 'date: 2014-09-15 '========================================================================================================================== on error resume next keyisincollection = cbool(not isempty(colltemp(keytocheck))) on error goto 0 end function this code used in userform:
'========================================================================================================================== 'description: properties , procedure run userform 'originally written by: doug glancy 'modified by: troy pilewski 'date: 2015-03-31 '========================================================================================================================== option explicit 'declare modules level variables private mblnclosedwithok boolean private mchoicelist() string private sub cmdok_click() 'turns on boolean bit if user clicks ok button mblnclosedwithok = true 'hides userform me.hide end sub public property closedwithok() boolean 'sets property boolean bit of procedure cmdok_click() closedwithok = mblnclosedwithok end property private sub cmdcancel_click() 'turns off boolean bit if user clicks cancel button mblnclosedwithok = false 'hides userform me.hide end sub public property choicevalue() string 'assigns selected value in owner drop-down choicevalue = me.cboowner.value end property public property let choicelist(passedlist() string) 'set values select in combo box mchoicelist() = passedlist() end property
the code above requires userform_activate event, combobox populated:
private sub userform_activate() me.cboowner .list = mchoicelist() .listindex = 0 end end sub 
Comments
Post a Comment