Slow VBA Macro | MrExcel Message Board

I've made a macro in vba which is taking quite a bit of time to run (approx 70 secs) and was wondering if there's any way to make it run ... Forums What'snew Newposts ExcelArticles MrExcelPublishing Login Register What'snew Search Newposts Searchforums Menu Login Register Installtheapp Install Ifyouwouldliketopost,pleasecheckouttheMrExcelMessageBoardFAQandregisterhere.Ifyouforgotyourpassword,youcanresetyourpassword. Forums QuestionForums ExcelQuestions Youareusinganoutofdatebrowser.Itmaynotdisplaythisorotherwebsitescorrectly.Youshouldupgradeoruseanalternativebrowser. SlowVBAMacro Threadstarter steveh8204 Startdate Feb6,2022 S steveh8204 BoardRegular Joined Aug20,2018 Messages 143 I'vemadeamacroinvbawhichistakingquiteabitoftimetorun(approx70secs)andwaswonderingifthere'sanywaytomakeitrunmoreefficiently. Itbasicallyjustcopiesandpastesacoupleofvalues,pastestheminanothersheetthenextractsaboutadozenvalues,switchesthesheetthenpastesthemvaluesin.Itthenrepeatsthisprocessupto12times. There'safewformulasaswellinthefinaloutputsheetbutcan'timaginetheseholditupmuch.Themacrocodeisbelowifanyonewantstohavealook.Anytipsonhowtospeeditupwouldbeappreciated. Thanksinadvance. VBACode: Subgames_batch_compare() Range("C21").Value="Calculating...." Application.ScreenUpdating=False DimaAsVariant,bAsVariant,cAsVariant,dAsVariant,eAsVariant,fAsVariant,gAsVariant,hAsVariant DimiAsInteger,jAsVariant,kAsVariant,lAsVariant,mAsVariant,nAsVariant,oAsVariant,leagueAsVariant 'makesureselectedleaguefromtopleftmatches"SELECTLEAGUE" league=Range("D1") Worksheets("SELECTLEAGUE").Select Cells(2,5).Value=league Worksheets("Games").Select'backto"Games"sheet Fori=3To15 a=Cells(i,3)'selectedHomeTeamintovariablea b=Cells(i,5)'selectedAwayteamintovariableb Ifa=""Theni=15 Worksheets("H2H").Select Range("L3").Value=a'changeH2HHometeamtovariablea Range("S3").Value=b'changeH2HAwayteamtovariableb c=Range("L17")'declareashometeamgoalsscored d=Range("s18")'declareasawayteamGoalsscored e=Range("N17")'declareashometeamGoalsconceded f=Range("U18")'declareasawayteamGoalsconceded g=Range("n46")'declareascleansheetshome h=Range("n52")'declareasfailedtoscoreHome j=Range("u47")'declareascleansheetsaway k=Range("u53")'declareasfailedtoscoreaway l=Range("l11")'declareashomepositionOverall m=Range("l12")'declareashomepositionhome n=Range("s13")'declareasawaypositionaway o=Range("s11")'declareasawaypositionoverall p=Range("q206")'declareashometeampointslast4 q=Range("Z207")'declareasawayteampointslast4 Ifa=""Thenc="N/A" Ifa=""Thend="N/A" Ifa=""Thene="N/A" Ifa=""Thend="N/A" Ifa=""Thenf="N/A" Ifa=""Theng="N/A" Ifa=""Thenh="N/A" Ifa=""Thenj="N/A" Ifa=""Thenk="N/A" Ifa=""Thenl="N/A" Ifa=""Thenm="N/A" Ifa=""Thenn="N/A" Ifa=""Theno="N/A" Worksheets("Games").Select Cells(i,7).Value=c'goalsscoredH Cells(i,8).Value=d'goalsscoredA Cells(i,10).Value=e'goalsconcededH Cells(i,11).Value=f'goalsconcededA Cells(i,13).Value=g'cleansheetshome Cells(i,14).Value=h'failedtoscoreHome Cells(i,15).Value=j'cleansheetsaway Cells(i,16).Value=k'failedtoscoreAway Cells(i,17).Value=l'homepositionoverall Cells(i,18).Value=m'homepositionhome Cells(i,19).Value=n'awaypositionaway Cells(i,20).Value=o'awaypositionoverall Cells(i,26).Value=p'hometeampointslast4 Cells(i,27).Value=q'awayteampointslast4 Nexti Application.ScreenUpdating=True Range("C21").Value="Complete!" EndSub   ExcelFacts WhendidPowerQuerydebutinExcel? Clickheretorevealanswer Althoughitwasanadd-ininExcel2010&Excel2013,PowerQuerybecameapartofExcelin2016,inData,Get&TransformData. 1 2 3 Next 1of3 Next Last M Micron Well-knownMember Joined Jun3,2015 Messages 3,455 OfficeVersion 365 Platform Windows Nothingobvioustomere:takingtoolong.However, -youhaveacoupleofundeclaredvariables(p&q) -mightbefasterifsomanyvariableswerenotvariants -Ifa=""Theni=15issupposedtostopcodeexecution,itwon't.Thecounterwillthenbe15butwillstillprocesstheremainderoftheForNextLoop,allthewaydowntoNexti.Notsureifthat'swhatyouwant,especiallysinceyou'dbesettingalllettervariablestoN/A,thenthecellstoN/AMightaswelljustsetthecellsandcutoutthecodethatsetsthevariables? Maybeyoushouldnesttheloopinatrue/falsetestlike IfNotIsNull(a)ThenorperhapsIfa<>""Thenandnesttheloopinsideofthat.BTW,theloopomitsIandL? Sometimesthelengthoftimeittakesismostlyinfluencedbytheavailablepcresources.   A AlexBlakenburg MrExcelMVP Joined Feb23,2021 Messages 4,021 OfficeVersion 365 Platform Windows Ihavemadesomechangeswhichmayormaynotmakemuchdifference. Idon'thaveanyofyourdataandIassumesheetH2Hisdoinglookupsand/orcalculationsbasedonthechanginginthevaluesofa(L3)&b(S3). WhatItriedtodois: Getridoftheselectstatements Reducethenumberofwriteoperationsbywritingmanyofthecellsoutasanarray. (Youroutputisskippingsomecolumns.Iftheyareblankandwecouldwriteitoutasasinglearraythatwouldhelptoo) Combinethemultipleifstatements(mentionedby@Micron) WouldtheIfa=""Theni=15bebetterservedbyanIfa=""ThenExitFor Whatistheintentionhere? VBACode: Subgames_batch_compare() Worksheets("Games").Range("C21").Value="Calculating...." Application.ScreenUpdating=False DimaAsVariant,bAsVariant,cAsVariant,dAsVariant,eAsVariant,fAsVariant,gAsVariant,hAsVariant DimiAsInteger,jAsVariant,kAsVariant,lAsVariant,mAsVariant,nAsVariant,oAsVariant,leagueAsVariant 'XXXAdditionalDeclarations DimarrOut DimpAsVariant,qAsVariant 'makesureselectedleaguefromtopleftmatches"SELECTLEAGUE" league=Worksheets("Games").Range("D1") Worksheets("SELECTLEAGUE").Cells(2,5).Value=league Fori=3To15 WithWorksheets("Games") a=.Cells(i,3)'selectedHomeTeamintovariablea b=.Cells(i,5)'selectedAwayteamintovariableb EndWith Ifa=""Theni=15 WithWorksheets("H2H") .Range("L3").Value=a'changeH2HHometeamtovariablea .Range("S3").Value=b'changeH2HAwayteamtovariableb c=.Range("L17")'declareashometeamgoalsscored d=.Range("s18")'declareasawayteamGoalsscored e=.Range("N17")'declareashometeamGoalsconceded f=.Range("U18")'declareasawayteamGoalsconceded g=.Range("n46")'declareascleansheetshome h=.Range("n52")'declareasfailedtoscoreHome j=.Range("u47")'declareascleansheetsaway k=.Range("u53")'declareasfailedtoscoreaway l=.Range("l11")'declareashomepositionOverall m=.Range("l12")'declareashomepositionhome n=.Range("s13")'declareasawaypositionaway o=.Range("s11")'declareasawaypositionoverall p=.Range("q206")'declareashometeampointslast4 q=.Range("Z207")'declareasawayteampointslast4 EndWith Ifa=""Then c="N/A" d="N/A" e="N/A" d="N/A" f="N/A" g="N/A" h="N/A" j="N/A" k="N/A" l="N/A" m="N/A" n="N/A" o="N/A" EndIf WithWorksheets("Games") .Cells(i,7).Value=c'goalsscoredH .Cells(i,8).Value=d'goalsscoredA .Cells(i,10).Value=e'goalsconcededH .Cells(i,11).Value=f'goalsconcededA arrOut=Array(g,h,j,k,l,m,n,o) .Cells(i,13).Resize(,UBound(arrOut)+1)=arrOut .Cells(i,26).Value=p'hometeampointslast4 .Cells(i,27).Value=q'awayteampointslast4 EndWith Nexti Application.ScreenUpdating=True Worksheets("Games").Range("C21").Value="Complete!" EndSub   Solution S steveh8204 BoardRegular Joined Aug20,2018 Messages 143 AlexBlakenburgsaid: Ihavemadesomechangeswhichmayormaynotmakemuchdifference. Idon'thaveanyofyourdataandIassumesheetH2Hisdoinglookupsand/orcalculationsbasedonthechanginginthevaluesofa(L3)&b(S3). WhatItriedtodois: Getridoftheselectstatements Reducethenumberofwriteoperationsbywritingmanyofthecellsoutasanarray. (Youroutputisskippingsomecolumns.Iftheyareblankandwecouldwriteitoutasasinglearraythatwouldhelptoo) Combinethemultipleifstatements(mentionedby@Micron) WouldtheIfa=""Theni=15bebetterservedbyanIfa=""ThenExitFor Whatistheintentionhere? VBACode: Subgames_batch_compare() Worksheets("Games").Range("C21").Value="Calculating...." Application.ScreenUpdating=False DimaAsVariant,bAsVariant,cAsVariant,dAsVariant,eAsVariant,fAsVariant,gAsVariant,hAsVariant DimiAsInteger,jAsVariant,kAsVariant,lAsVariant,mAsVariant,nAsVariant,oAsVariant,leagueAsVariant 'XXXAdditionalDeclarations DimarrOut DimpAsVariant,qAsVariant 'makesureselectedleaguefromtopleftmatches"SELECTLEAGUE" league=Worksheets("Games").Range("D1") Worksheets("SELECTLEAGUE").Cells(2,5).Value=league Fori=3To15 WithWorksheets("Games") a=.Cells(i,3)'selectedHomeTeamintovariablea b=.Cells(i,5)'selectedAwayteamintovariableb EndWith Ifa=""Theni=15 WithWorksheets("H2H") .Range("L3").Value=a'changeH2HHometeamtovariablea .Range("S3").Value=b'changeH2HAwayteamtovariableb c=.Range("L17")'declareashometeamgoalsscored d=.Range("s18")'declareasawayteamGoalsscored e=.Range("N17")'declareashometeamGoalsconceded f=.Range("U18")'declareasawayteamGoalsconceded g=.Range("n46")'declareascleansheetshome h=.Range("n52")'declareasfailedtoscoreHome j=.Range("u47")'declareascleansheetsaway k=.Range("u53")'declareasfailedtoscoreaway l=.Range("l11")'declareashomepositionOverall m=.Range("l12")'declareashomepositionhome n=.Range("s13")'declareasawaypositionaway o=.Range("s11")'declareasawaypositionoverall p=.Range("q206")'declareashometeampointslast4 q=.Range("Z207")'declareasawayteampointslast4 EndWith Ifa=""Then c="N/A" d="N/A" e="N/A" d="N/A" f="N/A" g="N/A" h="N/A" j="N/A" k="N/A" l="N/A" m="N/A" n="N/A" o="N/A" EndIf WithWorksheets("Games") .Cells(i,7).Value=c'goalsscoredH .Cells(i,8).Value=d'goalsscoredA .Cells(i,10).Value=e'goalsconcededH .Cells(i,11).Value=f'goalsconcededA arrOut=Array(g,h,j,k,l,m,n,o) .Cells(i,13).Resize(,UBound(arrOut)+1)=arrOut .Cells(i,26).Value=p'hometeampointslast4 .Cells(i,27).Value=q'awayteampointslast4 EndWith Nexti Application.ScreenUpdating=True Worksheets("Games").Range("C21").Value="Complete!" EndSub Clicktoexpand... Right,thanksforthis,justranmyoriginalcodewhichactuallytook1m38s(didn'trealiseitwasthatlong).Yourcodeimmediatelytookitdownto1mflat. Theskippedcolumnsareduetotherebeingformulasto'crunch'someofthedataimported. The"ifA"etccodeisbasicallyforifthetableisempty,Ithoughtchangingito15wouldthenjustskiptheprocess. ItriedmoreexplicitlydeclaringthevariablesaseitherDoubleorIntegerasrequiredbutitkeptthrowingerrorssurprisinglysoI'vekeptthemasVariants. Thanksagainthough,hugeincreaseinefficiency,muchappreciated.IusethissheetquiteregularlybuthavemovedonfromlearningVBAtoWebDevelopmentsostillunsureonafairbitofcodewhichcouldbeuseful.Idon'tneedtoknowmuchmorethoughsoyourhelpisverymuchappreciated.   S steveh8204 BoardRegular Joined Aug20,2018 Messages 143 ADVERTISEMENT Micronsaid: Nothingobvioustomere:takingtoolong.However, -youhaveacoupleofundeclaredvariables(p&q) -mightbefasterifsomanyvariableswerenotvariants -Ifa=""Theni=15issupposedtostopcodeexecution,itwon't.Thecounterwillthenbe15butwillstillprocesstheremainderoftheForNextLoop,allthewaydowntoNexti.Notsureifthat'swhatyouwant,especiallysinceyou'dbesettingalllettervariablestoN/A,thenthecellstoN/AMightaswelljustsetthecellsandcutoutthecodethatsetsthevariables? Maybeyoushouldnesttheloopinatrue/falsetestlike IfNotIsNull(a)ThenorperhapsIfa<>""Thenandnesttheloopinsideofthat.BTW,theloopomitsIandL? Sometimesthelengthoftimeittakesismostlyinfluencedbytheavailablepcresources. Clicktoexpand... Thevariablesaredeclarednow,goodpoint.AspermyotherreplyinthisthreadthoughdeclaringIntegersandDoubleswherenecessaryjustdidn'twork. Yea,my"Ifa="etccodedefinetlyisn'tmyfinestworklol MyworkPCisquitedecentlyspeccedsowouldnthavethoughtthatwouldbetheissuebutitisafewyearsoldsomaybe.Trynottohaveanythingrunninginthebackground. NotsureifIknowenoughaboutnestingandtrue/falsetestsinVBA(IunderstandtheconceptjustnottoofamilarwiththesyntaxinVBA)toimplementthatunfortunately. Thanksforyourhelpthough,muchappreciated.   A AlexBlakenburg MrExcelMVP Joined Feb23,2021 Messages 4,021 OfficeVersion 365 Platform Windows Thanksforlettingusknowhowyouwentandgladthatithelpedalittle. Iknowyoudon'twanttospendtoomuchmoretimeonitbutinthepreviousIonlyreducedthewriteoperationabit,ifyoumakethebelowchangesyoucouldreducethereadoperationsaswell. eginarow(orcolumn)pullallthecellsyouneedtocopyintoasinglecontiguousrange. Youcanthenreadthatrangeinasingleoperationintoanarrayandusethatinyourcode(insteadofthecurrent14readoperations) Note:fortestingIfounditeasiertoputthevalueL17intothecellL17sothebelowwilllookabitoddbutH2hastheformula"=L17"init. 20220207VBASimpleassignmentspeedup.xlsmABCDEFGHIJKLMNOPQRSTU1ConsolidateCellstoCopyvariablename--->cdefghjklmnopQ2formulastopullthemtogether--->L17S18N17U18N46N52U47U53L11I12S13S11Q206Z207H2HCellFormulasRangeFormulaH2,J2H2=L17I2,K2I2=S18L2L2=N46M2M2=N52N2N2=U47O2O2=U53P2P2=L11R2R2=S13S2S2=S11T2T2=Q206U2U2=Z207 Theatthetopofthecodeadd:- VBACode: DimarrSrc()AsVariant DimzAsLong andreplacethec=...d=...sectionwiththis: VBACode: WithWorksheets("H2H") .Range("L3").Value=a'changeH2HHometeamtovariablea .Range("S3").Value=b'changeH2HAwayteamtovariableb arrSrc=.Range("H2:U2").Value z=1 c=arrSrc(1,z):z=z+1'declareashometeamgoalsscored d=arrSrc(1,z):z=z+1'declareasawayteamGoalsscored e=arrSrc(1,z):z=z+1'declareashometeamGoalsconceded f=arrSrc(1,z):z=z+1'declareasawayteamGoalsconceded g=arrSrc(1,z):z=z+1'declareascleansheetshome h=arrSrc(1,z):z=z+1'declareasfailedtoscoreHome j=arrSrc(1,z):z=z+1'declareascleansheetsaway k=arrSrc(1,z):z=z+1'declareasfailedtoscoreaway l=arrSrc(1,z):z=z+1'declareashomepositionOverall m=arrSrc(1,z):z=z+1'declareashomepositionhome n=arrSrc(1,z):z=z+1'declareasawaypositionaway o=arrSrc(1,z):z=z+1'declareasawaypositionoverall p=arrSrc(1,z):z=z+1'declareashometeampointslast4 q=arrSrc(1,z)'declareasawayteampointslast4 EndWith HmmacoupleoftheformulasappearabitoddintheXL2BB,with2lotsseemingtohavethesamecellreference,thisisnotthecasetheyarepullinginthecellsinthesameorderasyourctoq   S steveh8204 BoardRegular Joined Aug20,2018 Messages 143 ADVERTISEMENT AlexBlakenburgsaid: Thanksforlettingusknowhowyouwentandgladthatithelpedalittle. Iknowyoudon'twanttospendtoomuchmoretimeonitbutinthepreviousIonlyreducedthewriteoperationabit,ifyoumakethebelowchangesyoucouldreducethereadoperationsaswell. eginarow(orcolumn)pullallthecellsyouneedtocopyintoasinglecontiguousrange. Youcanthenreadthatrangeinasingleoperationintoanarrayandusethatinyourcode(insteadofthecurrent14readoperations) Note:fortestingIfounditeasiertoputthevalueL17intothecellL17sothebelowwilllookabitoddbutH2hastheformula"=L17"init. 20220207VBASimpleassignmentspeedup.xlsmABCDEFGHIJKLMNOPQRSTU1ConsolidateCellstoCopyvariablename--->cdefghjklmnopQ2formulastopullthemtogether--->L17S18N17U18N46N52U47U53L11I12S13S11Q206Z207H2HCellFormulasRangeFormulaH2,J2H2=L17I2,K2I2=S18L2L2=N46M2M2=N52N2N2=U47O2O2=U53P2P2=L11R2R2=S13S2S2=S11T2T2=Q206U2U2=Z207 Theatthetopofthecodeadd:- VBACode: DimarrSrc()AsVariant DimzAsLong andreplacethec=...d=...sectionwiththis: VBACode: WithWorksheets("H2H") .Range("L3").Value=a'changeH2HHometeamtovariablea .Range("S3").Value=b'changeH2HAwayteamtovariableb arrSrc=.Range("H2:U2").Value z=1 c=arrSrc(1,z):z=z+1'declareashometeamgoalsscored d=arrSrc(1,z):z=z+1'declareasawayteamGoalsscored e=arrSrc(1,z):z=z+1'declareashometeamGoalsconceded f=arrSrc(1,z):z=z+1'declareasawayteamGoalsconceded g=arrSrc(1,z):z=z+1'declareascleansheetshome h=arrSrc(1,z):z=z+1'declareasfailedtoscoreHome j=arrSrc(1,z):z=z+1'declareascleansheetsaway k=arrSrc(1,z):z=z+1'declareasfailedtoscoreaway l=arrSrc(1,z):z=z+1'declareashomepositionOverall m=arrSrc(1,z):z=z+1'declareashomepositionhome n=arrSrc(1,z):z=z+1'declareasawaypositionaway o=arrSrc(1,z):z=z+1'declareasawaypositionoverall p=arrSrc(1,z):z=z+1'declareashometeampointslast4 q=arrSrc(1,z)'declareasawayteampointslast4 EndWith HmmacoupleoftheformulasappearabitoddintheXL2BB,with2lotsseemingtohavethesamecellreference,thisisnotthecasetheyarepullinginthecellsinthesameorderasyourctoq Clicktoexpand... Niceone,I'vemanagedtocopyandpastethatallin,notmuchdifferenceunfortunately.Shame,assomereallynicecode. Thinkingaboutitthebiggestissuemustbecollectingthedata.EventhoughthisMacropullsdatafromelsewhereinthesamebook(the'working'Workbook)itreliesonanotherseperateWorkbook(theDataonlyworkbook)tobeopen. I'mnotsurehowitworksasIdidn'tcreatetheoriginalbook(halfofthe'working'bookI'vebeenworkingon)butiftheother'Data'Workbookisn'topeninthebackgroundallthedataintheworkingbookisblank(whichIextractthedatafrom).OnceI'selectleague'thedataintheworkingbookstaysthesamesodidn'tthinkitwouldmatterbutIguessitdoes. Thanksagainforyourhelpthough.Stillgotitdowntoalmosttwiceasquick.   A AlexBlakenburg MrExcelMVP Joined Feb23,2021 Messages 4,021 OfficeVersion 365 Platform Windows Thankyouforproviding,theresultsofyoutestingandtheaddionalexternallinkinformation. Iamnotabigfanoflinkingsheets,ittendstoslowdownthespreadsheetandIprefertouseasnapshotintime,soIhaveareferencepointthatIcangobacktoandnothaveitlinkedtosomethingthatmayormaynothavechanged.   S steveh8204 BoardRegular Joined Aug20,2018 Messages 143 AlexBlakenburgsaid: Thankyouforproviding,theresultsofyoutestingandtheaddionalexternallinkinformation. Iamnotabigfanoflinkingsheets,ittendstoslowdownthespreadsheetandIprefertouseasnapshotintime,soIhaveareferencepointthatIcangobacktoandnothaveitlinkedtosomethingthatmayormaynothavechanged. Clicktoexpand... Noproblem,yeametoo,I'mhappytoimportdata.Alwaysthoughtitwasstrangetoneedtohaveanotherfileopenpermanentlyalongsideit.   J johnnyL Well-knownMember Joined Nov7,2011 Messages 3,205 OfficeVersion 20132007 Platform Windows @steveh8204Givethisoneatryifyoudon'tmind: VBACode: Subgames_batch_compareV2() ' DimstartTimeAsSingle ' startTime=Timer'StarttheStopwatch ' Application.ScreenUpdating=False'TurnScreenUpdatingoff ' DimaAsVariant,bAsVariant,cAsVariant,dAsVariant,eAsVariant,fAsVariant,gAsVariant,hAsVariant DimiAsInteger,jAsVariant,kAsVariant,lAsVariant,mAsVariant,nAsVariant,oAsVariant DimleagueAsVariant ' DimH2H_CombinedRangesArrayAsCollection DimTeamLastRowAsLong,TeamStartRowAsLong DimGamesArray1AsVariant,GamesArray2AsVariant,GamesArray3AsVariant,GamesArray4AsVariant,GamesArray5AsVariant DimTeamsArrayAsVariant,H2H_ArrayAsVariant ' TeamStartRow=3'