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

  1. anniversaries month
  2. anniversaries next month
  3. anniversaries week
  4. anniversaries next week
  5. 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.

  1. is there better way other using collection? if how can done? (i prefer not use outside vba capabilities)

  2. the sorting feature have implemented in collection not working , leads errors. please suggest way use sorting correctly. provide code. new collections.

notes:

  1. some custom functions used in code. don't bother if see not available in excel default.

  2. 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

Popular posts from this blog

matlab - Deleting rows with specific rules -

php - MySQLi multi_query results for later use -