Home 
Search 
Today's Posts 
#1




Performance lag issue
Hi Team
I was given a workbook with approx. 100,000 rows in total which they want to draw demographics from over there network which has a hamster treadmill for speed.. I actually used cell formulas to begin with and noticed two things happen: 1. the file ballooned to a an unmanageable size. ( should be a Database IMO ). 2. It literally ground to a halt the more rows I copied the formula to. I decided to code it and came up with this and by all accounts the following does what I need it to do, albeit at a snails pace like almost 4 mins for 500 rows when I broke into the code as it was taking way too long. Inasmuch as it will most likely not make much sense without any file or data , but! I am hoping maybe you guys can see if there is a simplified approach that could turn this Model T into a Ferrari.. lol. As always Many thanks in advanced. Kind regards Mark. Sub Process_Me() With Application .ScreenUpdating = False .EnableEvents = False End With Dim myWbook As Workbook Dim myRange As Range, c As Range Set myWbook = ThisWorkbook Set myRange = Sheets("Data").Range("L2:L10000") For Each c In myRange If Not c = "" Then With c.Offset(, 1) .FormulaR1C1 = "=IF(RC[3]="""","""",(RC[3]INT(RC[3])))" .Value = .Value End With With c.Offset(, 2) .FormulaR1C1 = "=IF(RC[4]="""","""",IF(OR(RC5=RC33, RC5=RC34, 1),2))" .Value = .Value End With With c.Offset(, 3) .FormulaR1C1 = "=IF(AND(RC14=2,RC13<0.25),(RC13+0.5),(RC13))" .Value = .Value End With With c.Offset(, 4) .FormulaR1C1 = "=RC15" .Value = .Value End With With c.Offset(, 5) .FormulaR1C1 = "=IF(RC11="""","""",RC11INT(RC11))" .Value = .Value End With With c.Offset(, 6) .FormulaR1C1 = "=IF(RC15="""","""",IF(RC17RC15,RC17RC15,RC15RC17))" .Value = .Value End With With c.Offset(, 7) .FormulaR1C1 = "=IF(RC16="""","""",IF(RC17RC16,""LATE"",IF(RC17< RC16,""EARLY"",""ON TIME"")))" .Value = .Value End With With c.Offset(, 8) .FormulaR1C1 = "=IF(RC[14]="""","""",IF(AND(RC19=""LATE"",(RC17RC16<0.0208)),""ON TIME"",IF(RC17<RC16,""EARLY"",IF(RC17=RC16,""ON TIME"",""LATE""))))" .Value = .Value End With With c.Offset(, 9) .FormulaR1C1 = "=IF(RC12="""","""",TIME(HOUR(RC12),MINUTE(RC12),S ECOND(RC12)))" .Value = .Value End With With c.Offset(, 10) .FormulaR1C1 = "=IF(RC9="""","""",RC91)" .Value = .Value End With With c.Offset(, 11) .FormulaR1C1 = "=IF(COUNTIFS(RC11:RC11,RC11,RC8:RC8,RC8,RC17:RC17 ,RC17)=1,1,"""")" .Value = .Value End With With c.Offset(, 12) .FormulaR1C1 = "=SUMIFS(C[15]:C[15],C[16]:C[16],RC[16],C[13]:C[13],RC[13])" .Value = .Value End With With c.Offset(, 13) .FormulaR1C1 = "=IF(RC[2]="""","""",((RC[2]*RC[3])1))" .Value = .Value End With With c.Offset(, 14) .FormulaR1C1 = "=IF(RC[3]<1,0,IF(RC[1]24,23,RC[1]))" .Value = .Value End With With c.Offset(, 15) .FormulaR1C1 = "=IF(RC[1]0,15,0)" .Value = .Value End With With c.Offset(, 16) .FormulaR1C1 = "=IF(ISERROR(RC[4]*2+RC[1]),0,(RC[4]*2+RC[1]))" .Value = .Value End With With c.Offset(, 17) .FormulaR1C1 = "=IF(RC[1]=0,0,(RC[1]/1440))" .Value = .Value End With With c.Offset(, 18) .FormulaR1C1 = "=IF(RC[7]<1,0,IF(RC[14]RC[9],0,IF(RC[13]<RC[14],RC[9]RC[14],RC[9]RC[13])))" .Value = .Value End With With c.Offset(, 19) .FormulaR1C1 = "=IF(RC[8]<1,0,IF(RC[1]RC[2],0,IF(RC[1]RC[2],0)))" .Value = .Value End With With c.Offset(, 20) .FormulaR1C1 = "=IF(RC12="""","""",TRIM(RC5))" .Value = .Value End With Else: Exit Sub End If Next c With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 
#2




Performance lag issue
Hi Mark,
Am Tue, 13 Feb 2018 05:12:42 0800 (PST) schrieb Living the Dream: I actually used cell formulas to begin with and noticed two things happen: 1. the file ballooned to a an unmanageable size. ( should be a Database IMO ). 2. It literally ground to a halt the more rows I copied the formula to. try: Sub Process_Me() Dim LRow As Long Dim iCalc As Integer With Application .ScreenUpdating = False .EnableEvents = False iCalc = .Calculation .Calculation = xlCalculationManual End With Dim myWbook As Workbook Set myWbook = ThisWorkbook With Sheets("Data") LRow = .Cells(.Rows.Count, "L").End(xlUp).Row With .Cells(2, 13).Resize(LRow  1) .Formula = "=IF(J2="""","""",(J2INT(J2)))" .Value = .Value End With With .Cells(2, 14).Resize(LRow  1) .Formula = "=IF(J2="""","""",IF(OR($E2=$AG2, $E2=$AH2, 1),2))" .Value = .Value End With With .Cells(2, 15).Resize(LRow  1) .Formula = "=IF(AND($N2=2,$M2<0.25),($M2+0.5),($M2))" .Value = .Value End With With .Cells(2, 16).Resize(LRow  1) .Formula = "=$O2" .Value = .Value End With With .Cells(2, 17).Resize(LRow  1) .Formula = "=IF($K2="""","""",$K2INT($K2))" .Value = .Value End With With .Cells(2, 18).Resize(LRow  1) .Formula = "=IF($O2="""","""",IF($Q2$O2,$Q2$O2,$O2$Q2))" .Value = .Value End With With .Cells(2, 19).Resize(LRow  1) .Formula = "=IF($P2="""","""",IF($Q2$P2,""LATE"",IF($Q2<$P2, ""EARLY"",""ON TIME"")))" .Value = .Value End With With .Cells(2, 20).Resize(LRow  1) .Formula = "=IF(F2="""","""",IF(AND($S2=""LATE"",($Q2$P2<0.0208)),""ON TIME"",IF($Q2<$P2,""EARLY"",IF($Q2=$P2,""ON TIME"",""LATE""))))" .Value = .Value End With With .Cells(2, 21).Resize(LRow  1) .Formula = "=IF($L2="""","""",TIME(HOUR($L2),MINUTE($L2),SECO ND($L2)))" .Value = .Value End With With .Cells(2, 22).Resize(LRow  1) .Formula = "=IF($I2="""","""",$I21)" .Value = .Value End With With .Cells(2, 23).Resize(LRow  1) .Formula = "=IF(COUNTIFS($K2:$K2,$K2,$H2:$H2,$H2,$Q2:$Q2,$Q2) =1,1,"""")" .Value = .Value End With With .Cells(2, 24).Resize(LRow  1) .Formula = "=SUMIFS(I:I,H:H,H2,K:K,K2)" .Value = .Value End With With .Cells(2, 25).Resize(LRow  1) .Formula = "=IF(W2="""","""",((W2*V2)1))" .Value = .Value End With With .Cells(2, 26).Resize(LRow  1) .Formula = "=IF(W2<1,0,IF(Y224,23,Y2))" .Value = .Value End With With .Cells(2, 27).Resize(LRow  1) .Formula = "=IF(Z20,15,0)" .Value = .Value End With With .Cells(2, 28).Resize(LRow  1) .Formula = "=IF(ISERROR(X2*2+AA2),0,(X2*2+AA2))" .Value = .Value End With With .Cells(2, 29).Resize(LRow  1) .Formula = "=IF(AB2=0,0,(AB2/1440))" .Value = .Value End With With .Cells(2, 30).Resize(LRow  1) .Formula = "=IF(W2<1,0,IF(P2U2,0,IF(Q2<P2,U2P2,U2Q2)))" .Value = .Value End With With .Cells(2, 31).Resize(LRow  1) .Formula = "=IF(W2<1,0,IF(AD2AC2,0,IF(AD2AC2,0)))" .Value = .Value End With With .Cells(2, 32).Resize(LRow  1) .Formula = "=IF($L2="""","""",TRIM($E2))" .Value = .Value End With End With With Application .ScreenUpdating = True .EnableEvents = True .Calculation = iCalc End With End Sub Regards Claus B.  Windows10 Office 2016 
#3




Performance lag issue
Try this way to see if it's any faster...
Option Explicit Sub Test() Dim rng As Range Set rng = Range("L2:L10000").Resize(, 21) Application.Index(rng, 0, 2) = "=IF(RC[3]="""","""",(RC[3]INT(RC[3])))" Application.Index(rng, 0, 3) = "=IF(RC[4]="""","""",IF(OR(RC5=RC33,RC5=RC34,1),2))" Application.Index(rng, 0, 4) = "=IF(AND(RC14=2,RC13<0.25),RC13+0.5,RC13)" Application.Index(rng, 0, 5) = "=RC15" Application.Index(rng, 0, 6) = "=IF(RC11="""","""",RC11INT(RC11))" Application.Index(rng, 0, 7) = "=IF(RC15="""","""",IF(RC17RC15,RC17RC15,RC15RC17))" Application.Index(rng, 0, 8) = "=IF(RC16="""","""",IF(RC17RC16,""LATE"",IF(RC17< RC16,""EARLY"",""ON TIME"")))" Application.Index(rng, 0, 9) = "=IF(RC[14]="""","""",IF(AND(RC19=""LATE"",(RC17RC16<0.0208)),""ON TIME"",IF(RC17<RC16,""EARLY"",IF(RC17=RC16,""ON TIME"",""LATE""))))" Application.Index(rng, 0, 10) = "=IF(RC12="""","""",TIME(HOUR(RC12),MINUTE(RC12),S ECOND(RC12)))" Application.Index(rng, 0, 11) = "=IF(RC9="""","""",RC91)" Application.Index(rng, 0, 12) = "=IF(COUNTIFS(RC11:RC11,RC8:RC8,RC17:RC17,RC17)=1, 1,"""")" Application.Index(rng, 0, 13) = "=SUMIFS(C[15]:C[15],C[16]:C[16],RC[16],C[13]:C[13],RC[13])" Application.Index(rng, 0, 14) = "=IF(RC[2]="""","""",((RC[2]*RC[3])1))" Application.Index(rng, 0, 15) = "=IF(RC[3]<1,0,IF(RC[1]24,23,RC[1]))" Application.Index(rng, 0, 16) = "=IF(RC[1]0,15,0)" Application.Index(rng, 0, 17) = "=IF(ISERROR(RC[4]*2+RC[1]),0,(RC[4]*2+RC[1]))" Application.Index(rng, 0, 18) = "=IF(RC[1]=0,0,(RC[1]/1440))" Application.Index(rng, 0, 19) = "=IF(RC[7]<1,0,IF(RC[14]RC[9],0,IF(RC[13]<RC[14],RC[9]RC[14],RC[9]RC[13])))" Application.Index(rng, 0, 20) = "=IF(RC[8]<1,0,IF(RC[1]RC[2],0,IF(RC[1]RC[2],0)))" Application.Index(rng, 0, 21) = "=IF(RC12="""","""",TRIM(RC5))" With Range("M2:M10000").Resize(, 20): .Value = .Value: End With End Sub  Garry Free usenet access at http://www.eternalseptember.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion 
#4




Performance lag issue
To handle long procedures that have the nature to slow things down, I use this
EnableFastCode routine located in a module named "mWorkspace": Option Explicit Type udtAppModes 'Default types Events As Boolean: CalcMode As XlCalculation: Display As Boolean: CallerID As String 'Projectspecific types End Type Public AppMode As udtAppModes Sub EnableFastCode(Caller$, Optional SetFast As Boolean = True) ' **Note: Requires 'Type udtAppModes' and 'Public AppMode As udtAppModes' declarations 'The following will make sure only the Caller has control, 'and allows any Caller to take control when not in use. If AppMode.CallerID < Caller Then _ If AppMode.CallerID < "" Then Exit Sub With Application If SetFast Then AppMode.Display = .ScreenUpdating: .ScreenUpdating = False AppMode.CalcMode = .Calculation: .Calculation = xlCalculationManual AppMode.Events = .EnableEvents: .EnableEvents = False AppMode.CallerID = Caller Else .ScreenUpdating = AppMode.Display .Calculation = AppMode.CalcMode .EnableEvents = AppMode.Events AppMode.CallerID = "" End If End With End Sub Once a CallerId is logged, no other procedures can 'toggle' the settings. That ensures that your caller has control until it's done with it. I use it like this: Sub DoThis() Const sSrc$ = "DoThis" '... '... '... EnableFastCode sSrc '//lockout 'lengthy processes here EnableFastCode sSrc, False '//release '... '... End Sub  Garry Free usenet access at http://www.eternalseptember.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion 
#5




Performance lag issue
Hi Mark,
Am Tue, 13 Feb 2018 15:50:25 +0100 schrieb Claus Busch: Sub Process_Me() Dim LRow As Long Dim iCalc As Integer ignore the previous answer. Better try: Sub Process_Me() Dim LRow As Long Dim myWbook As Workbook With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With On Error GoTo CleanUp Set myWbook = ThisWorkbook With Sheets("Data") LRow = .Cells(.Rows.Count, "L").End(xlUp).Row .Cells(2, 13).Resize(LRow  1).Formula = _ "=IF(J2="""","""",(J2INT(J2)))" .Cells(2, 14).Resize(LRow  1).Formula = _ "=IF(J2="""","""",IF(OR($E2=$AG2, $E2=$AH2, 1),2))" .Cells(2, 15).Resize(LRow  1).Formula = _ "=IF(AND($N2=2,$M2<0.25),($M2+0.5),($M2))" .Cells(2, 16).Resize(LRow  1).Formula = "=$O2" .Cells(2, 17).Resize(LRow  1).Formula = _ "=IF($K2="""","""",$K2INT($K2))" .Cells(2, 18).Resize(LRow  1).Formula = _ "=IF($O2="""","""",IF($Q2$O2,$Q2$O2,$O2$Q2))" .Cells(2, 19).Resize(LRow  1).Formula = _ "=IF($P2="""","""",IF($Q2$P2,""LATE"",IF($Q2<$P2, ""EARLY"",""ON TIME"")))" .Cells(2, 20).Resize(LRow  1).Formula = _ "=IF(F2="""","""",IF(AND($S2=""LATE"",($Q2$P2<0.0208)),""ON TIME"",IF($Q2<$P2,""EARLY"",IF($Q2=$P2,""ON TIME"",""LATE""))))" .Cells(2, 21).Resize(LRow  1).Formula = _ "=IF($L2="""","""",TIME(HOUR($L2),MINUTE($L2),SECO ND($L2)))" .Cells(2, 22).Resize(LRow  1).Formula = "=IF($I2="""","""",$I21)" .Cells(2, 23).Resize(LRow  1).Formula = _ "=IF(COUNTIFS($K2:$K2,$K2,$H2:$H2,$H2,$Q2:$Q2,$Q2) =1,1,"""")" .Cells(2, 24).Resize(LRow  1).Formula = "=SUMIFS(I:I,H:H,H2,K:K,K2)" .Cells(2, 25).Resize(LRow  1).Formula = "=IF(W2="""","""",((W2*V2)1))" .Cells(2, 26).Resize(LRow  1).Formula = "=IF(W2<1,0,IF(Y224,23,Y2))" .Cells(2, 27).Resize(LRow  1).Formula = "=IF(Z20,15,0)" .Cells(2, 28).Resize(LRow  1).Formula = "=IF(ISERROR(X2*2+AA2),0,(X2*2+AA2))" .Cells(2, 29).Resize(LRow  1).Formula = "=IF(AB2=0,0,(AB2/1440))" .Cells(2, 30).Resize(LRow  1).Formula = _ "=IF(W2<1,0,IF(P2U2,0,IF(Q2<P2,U2P2,U2Q2)))" .Cells(2, 31).Resize(LRow  1).Formula = _ "=IF(W2<1,0,IF(AD2AC2,0,IF(AD2AC2,0)))" .Cells(2, 32).Resize(LRow  1).Formula = "=IF($L2="""","""",TRIM($E2))" CleanUp: With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlAutomatic End With With .Range("M2:AF" & LRow) .Value = .Value End With End With End Sub Regards Claus B.  Windows10 Office 2016 
#6




Performance lag issue
Garry & Claus
Thank you once again, you guys are amazing. Garry Not wanting you to feel your contribution wasn't appreciated, I "will" try your idea later when I have time; I went with Claus'code as it was quick which got me where I needed to be today. Claus As I have already captured the results of the original data rows in Columns A:L which is the target region where Data will get updated to each week, is there a way to skip the code so it doesn't always start at Row 2, rather start at the first newly added data that has a blank cell in Column "M". BTW Code took roughly 60 secs to do just under 100k rows, very neat, thank you. Once again Many thanks Mark. 
#7




Performance lag issue
Garry & Claus
Thank you once again, you guys are amazing. Garry Not wanting you to feel your contribution wasn't appreciated, I "will" try your idea later when I have time; I went with Claus'code as it was quick which got me where I needed to be today. Enjoy! Claus As I have already captured the results of the original data rows in Columns A:L which is the target region where Data will get updated to each week, is there a way to skip the code so it doesn't always start at Row 2, rather start at the first newly added data that has a blank cell in Column "M". BTW Code took roughly 60 secs to do just under 100k rows, very neat, thank you. Once again Many thanks Mark.  Garry Free usenet access at http://www.eternalseptember.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion 
#8




Performance lag issue
Code took roughly 60 secs to do just under 100k rows, very neat, thank you.
FYI Took mine less than 2 secs to do 10K rows, 20 cols!  Garry Free usenet access at http://www.eternalseptember.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion 
Reply 
Thread Tools  Search this Thread 
Display Modes  


Similar Threads  
Thread  Forum  
Performance Issue  Excel Discussion (Misc queries)  
Performance issue  Excel Programming  
Excel Performance issue  Excel Discussion (Misc queries)  
Performance Issue with Database Connection  Excel Programming  
Iteration performance issue  Excel Programming 