Code optimization - Excel VBA Collection and collection sorting -
i have excel sheet details of employees. need display details on sheet regarding years in company.
the details want show are
- anniversaries month
- anniversaries next month
- anniversaries week
- anniversaries next week
- anniversaries today
i need show these details employee name, anniversary date , years in company. each of these details should shown in table headers , in same columns (b, c , d).
all of done code below sort feature not working , need know whether there more effective way of using collection in case.
here code have.
sub populateanniversarydata() 'declaring collections set todayanv = new collection 'collection store anniversaries today. set thisweekanv = new collection 'collection store anniversaries week. set nextweekanv = new collection 'collection store anniversaries next week. set currentmonthanv = new collection 'collection store anniversaries of current month. set nextmonthanv = new collection 'collection store anniversaries of next month. 'getting current details currentday = day(now()) 'getting current year. currentmonth = month(now()) 'getting current month. currentyear = year(now()) 'getting current year. currentweek = application.worksheetfunction.weeknum(now()) 'getting current week number. currentdate = year(now()) & "/" & month(now()) & "/" & day(now()) 'forming current date. empdetailslr = lastrowincolumn(1, ed.name) 'finding last row in employee details page. dim empadate date 'declaring variable hold employee anniversary date. empdetailsfr = 2 empdetailslr joiningmonth = month(ed.range(joindatecolumnna & empdetailsfr).value) 'finding employee joining month. joiningday = day(ed.range(joindatecolumnna & empdetailsfr).value) 'finding employee joining day. joiningyear = year(ed.range(joindatecolumnna & empdetailsfr).value) 'finding employee joining year. yearsiney = currentyear - joiningyear 'finding number of years employee worked ey. empname = ed.range("c" & empdetailsfr).value 'finding employee name. empjdate = ed.range(joindatecolumnna & empdetailsfr).value 'finding employee joining date. empadate = year(now()) & "/" & month(empjdate) & "/" & day(empjdate) 'forming employee anniversary date. joiningweek = application.worksheetfunction.weeknum(empadate) 'finding employee joining week. if trim(lcase(ed.range("h" & empdetailsfr).value)) <> "resigned" , yearsiney > 0 'finding employees anniversary today. if currentdate = empadate _ todayanv.add array(empname, "today", yearsiney) 'finding employees anniversary week. if currentweek = joiningweek _ thisweekanv.add array(empname, weekdayname(empadate), yearsiney) 'finding employees anniversary next week. if currentweek + 1 = joiningweek _ nextweekanv.add array(empname, empadate, yearsiney) 'finding employees anniversary month. if currentmonth = joiningmonth _ currentmonthanv.add array(empname, empadate, yearsiney) 'finding employees anniversary next month. if currentmonth + 1 = joiningmonth _ nextmonthanv.add array(empname, empadate, yearsiney) end if next 'sorting current month anniversaries based on anniversary date. collection_counti = 1 currentmonthanv.count - 1 collection_countj = collection_counti + 1 currentmonthanv.count if currentmonthanv(collection_counti)(1) > currentmonthanv(collection_countj)(1) 'store lesser item vtemp = currentmonthanv(collection_countj) 'remove lesser item currentmonthanv.remove collection_countj 're-add lesser item before greater item currentmonthanv.add vtemp(collection_counti) end if next collection_countj next collection_counti 'sorting next month anniversaries based on anniversary date. collection_counti = 1 nextmonthanv.count - 1 collection_countj = collection_counti + 1 nextmonthanv.count if nextmonthanv(collection_counti)(1) > nextmonthanv(collection_countj)(1) 'store lesser item vtemp2 = nextmonthanv(collection_countj) 'remove lesser item nextmonthanv.remove collection_countj 're-add lesser item before greater item nextmonthanv.add vtemp2(collection_counti) end if next collection_countj next collection_counti writeinrow = 3 'populating anniversaries month if currentmonthanv.count <> 0 an.range("b2").value = "anniversaries month" an.range("c2").value = "date" an.range("d2").value = "years in ey" anvdic = 1 currentmonthanv.count an.range("b" & writeinrow).value = currentmonthanv(anvdic)(0) an.range("c" & writeinrow).value = currentmonthanv(anvdic)(1) an.range("d" & writeinrow).value = currentmonthanv(anvdic)(2) writeinrow = writeinrow + 1 next writeinrow = writeinrow + 1 end if 'populating anniversaries next month if nextmonthanv.count <> 0 an.range("b" & writeinrow).value = "anniversaries next month" an.range("c" & writeinrow).value = "date" an.range("d" & writeinrow).value = "years in ey" writeinrow = writeinrow + 1 anvdic = 1 nextmonthanv.count an.range("b" & writeinrow).value = nextmonthanv(anvdic)(0) an.range("c" & writeinrow).value = nextmonthanv(anvdic)(1) an.range("d" & writeinrow).value = nextmonthanv(anvdic)(2) writeinrow = writeinrow + 1 next end if 'similarly populate anniv week, next week, today etc activesheet.columns.autofit end sub here things know.
is there better way other using collection? if how can done? (i prefer not use outside vba capabilities)
the sorting feature have implemented in collection not working , leads errors. please suggest way use sorting correctly. provide code. new collections.
notes:
some custom functions used in code. don't bother if see not available in excel default.
my employee details sheet sorted alphabetically. want implement sort based on anniversary dates.
to make code clean , manageable, 1 of way think object oriented way , create class module in vba excel.
example:
class module name : anniversary
content:
public employeename string public employeedate date public yearsiney string in module code, create new object class , assign values
dim otodayanniversary new anniversary otodayanniversary.employeename = value otodayanniversary.employeedate = value otodayanniversary.yearsiney = value use above collection print on new sheet.
you can create single collection, populate data, adding enum flag anniversary class module, identify category type.
Comments
Post a Comment