Compiling data from multiple worksheets to a master worksheet in a single workbook - VBA Excel Macro -


question: how can make macro run faster?

i download data single workbook. data made of list of variables (string in column a) , values (string or number in column b). "possible" configuration variables exist in master worksheet. each worksheet shares variables, not all, , may have unique variable needs added variable master list. compile data in 1 master worksheet using macro:

sub comparevariabledata()  dim mainws worksheet *'establishes worksheet variable* set mainws = worksheets(1) *'sets mainws master comparison* dim wscount long *'counts total number of worksheets in workbook* dim curwsnum long *'tracks current worksheet being compared* wscount = activeworkbook.worksheets.count *'gives wscount value equal number of     worksheets*  curwsnum = 2 wscount *'loop second worksheet last active worksheet* dim r long *'variable row in compared worksheet* dim mainwsrow long *'variable counter rows in master worksheet*   mainws.cells(1, curwsnum) = worksheets(curwsnum).name *'adds name of compared worksheet first row of first worksheet*   r = 3 worksheets(curwsnum).range("a" & rows.count).end(xlup).row *'loops third row of compared worksheet last used row*      curstr = worksheets(curwsnum).cells(r, 1) *'creates variable curstr capture variable name first column*      mainws.activate *'activates main ws next loop*   if not iserror(application.match(curstr, mainws.columns("a:a"), 0)) *'if there no error in match between compare variable , master variable list*     *'found*     mainws.cells(application.match(curstr, mainws.columns("a:a"), 0), curwsnum) = worksheets(curwsnum).cells(r, 2) *'adds value of variable compare worksheet master worksheet*  else     *'not found*     dim lastrow long *'makes variable lastrow add 'notfound' variable end of master list*     lastrow = mainws.range("a" & rows.count).end(xlup).row + 1 *'finds last row*      mainws.cells(lastrow, 1) = curstr *'adds variable master list*     mainws.cells(lastrow, curwsnum) = worksheets(curwsnum).cells(r, 2) *'adds value compared worksheet*     mainws.cells(lastrow, 1).interior.color = vbyellow *'highlights row*  end if  next  next  end sub 

welcome stackoverflow.

for future questions should give bit more information on problem: one, example, might have included symptom you're having (how long take run?), you've tried solve problem (what research did do, , did of help?), , other relevant details (like how big data set?).

none of below tested code, should safe try or of these, assuming don't rewrite use dictionary, tim suggests:

  1. as tim williams suggests above, use application.screenupdating = false , application.calculation = xlcalculationmanual @ start of code. sure turn these on @ end.
  2. move dim statments r, mainwsrow , lastrow out of loops (so dimensioned once, , not every loop).
  3. explicitly dimension curstr: typing variable should performance since un-dimmed , default variant (if read correctly, return string in data set)
  4. eliminating mainws.activate. activating , selecting items takes time, , besides don't think code needs written.

your resulting code might this:

    dim mainws worksheet         set mainws = worksheets(1)     dim wscount long         wscount = activeworkbook.worksheets.count     dim curwsnum long '~~>move following within loop structures     dim r long     dim mainwsrow long     dim lastrow long '~~>add type variable     dim curstr string '~~>add track initial calculation method restoring same value     dim mscalcstate string         mscalcstate = application.calculation  '~~>turn off updates during code run     application.screenupdating = false     application.calculation = xlcalculationmanual          curwsnum = 2 wscount             mainws.cells(1, curwsnum) = worksheets(curwsnum).name             r = 3 worksheets(curwsnum).range("a" & rows.count).end(xlup).row '~~>remove mainws.activate                 curstr = worksheets(curwsnum).cells(r, 1)                 if not iserror(application.match(curstr, mainws.columns("a:a"), 0)) _                                     mainws.cells(application.match(curstr, mainws.columns("a:a"), _                         0), curwsnum) = worksheets(curwsnum).cells(r, 2)                 else                     lastrow = mainws.range("a" & rows.count).end(xlup).row + 1                     mainws.cells(lastrow, 1) = curstr                     mainws.cells(lastrow, curwsnum) = worksheets(curwsnum).cells(r, 2)                     mainws.cells(lastrow, 1).interior.color = vbyellow                 end if             next r         next curwsnum  '~~>restore update settings     application.screenupdating = true     application.calculation = mscalcstate 

that should part way there.


Comments

Popular posts from this blog

apache - Remove .php and add trailing slash in url using htaccess not loading css -

javascript - jQuery show full size image on click -