Tuesday 15 July 2014

excel vba - How do I make this VBA loop run faster? -



excel vba - How do I make this VBA loop run faster? -

this loop written excel takes ranges of 2 unique lists , searches them in table on different sheet. 2 column search, 2 values list must appear in row accumulator count. works fine when parse lots of info can waiting minutes on end. looking way create loop much faster. help appreciated. in advance.

sub parsetwo(byval startrng range, byval findrng range, _ byval pastestartrng range, byval strtitle string, byval findtablecolumn string, _ byval startoffset integer, byval handledoffset integer, _ byval handledbool boolean) '========================================================================== '========================================================================== 'turn off excel functionality code runs faster application.screenupdating = false application.displaystatusbar = false application.calculation = xlcalculationmanual application.enableevents = false '========================================================================== '========================================================================== dim x long 'declare accumulator. x = 0 'give x default value. '========================================================================== '========================================================================== dim firstloop boolean 'declare boolean value. firstloop = true 'declare initial value of boolean true. '========================================================================== '========================================================================== dim pastefindrng range 'set paste range "find" items. set pastefindrng = pastestartrng.offset(1, -1 dim pasteaccum range 'set paste range "accumulator". set pasteaccum = pastestartrng.offset(1, 0) '========================================================================== '========================================================================== dim initialfindrng range 'keep track of initial "find" range reference later. set initialfindrng = findrng '========================================================================== '========================================================================== while startrng.text <> vbnullstring 'do while there info in "start" range. while findrng.text <> vbnullstring 'do while there info in "find" range. worksheets("formatting").range("formattingtable[" & findtablecolumn & "]") set c = .find(findrng.text, lookin:=xlvalues, lookat:=xlwhole) firstaddress = c.address if handledbool = true if c.offset(0, handledoffset).text <> vbnullstring if c.offset(0, startoffset).text = startrng.text x = x + 1 end if end if else if c.offset(0, startoffset).text = startrng.text x = x + 1 end if end if set c = .findnext(c) loop while not c nil , c.address <> firstaddress end '========================================================================== '========================================================================== if firstloop = true 'if first time through loop paste find items pastefindrng.value = findrng.text set pastefindrng = pastefindrng.offset(1, 0) 'set pastefind range downwards 1 end if '========================================================================== pasteaccum.value = x 'set x paste. set pasteaccum = pasteaccum.offset(1, 0) 'set accumulator paste range downwards 1. x = 0 'reset x '========================================================================== set findrng = findrng.offset(1, 0) 'set find range downwards 1. '========================================================================== loop if firstloop = true 'if first time through loop paste title. pastestartrng.offset(0, -1) = strtitle end '========================================================================== pastestartrng.value = startrng.text 'paste value of start range. '========================================================================== set pastestartrng = pastestartrng.offset(0, 1) 'set paste start range on right 1. '========================================================================== set pasteaccum = pastestartrng.offset(1, 0) 'reset "accumulator" paste range. '========================================================================== set startrng = startrng.offset(1, 0) 'move "start" range downwards 1. set findrng = initialfindrng 'reset "find" range. '========================================================================== firstloop = false loop '======================================================================================== application.screenupdating = true application.displaystatusbar = true application.calculation = xlcalculationautomatic application.enableevents = true end sub

as tip, seek create variable with

range("formattingtable[" & findtablecolumn & "]")

value , avoid within loop. or improve replace:

worksheets("formatting").range("formattingtable[" & findtablecolumn & "]")

by range value within loop.

excel-vba nested-loops

No comments:

Post a Comment