Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Old February 13th 18, 02:12 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2012
Posts: 141
Default 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.

In-as-much 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="""","""",RC11-INT(RC11))"
.Value = .Value
End With
With c.Offset(, 6)
.FormulaR1C1 = "=IF(RC15="""","""",IF(RC17RC15,RC17-RC15,RC15-RC17))"
.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"",(RC17-RC16<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="""","""",RC9-1)"
.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   Report Post  
Old February 13th 18, 03:50 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2011
Posts: 3,566
Default 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="""","""",(J2-INT(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="""","""",$K2-INT($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="""","""",$I2-1)"
.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,U2-P2,U2-Q2)))"
.Value = .Value
End With
With .Cells(2, 31).Resize(LRow - 1)
.Formula = "=IF(W2<1,0,IF(AD2AC2,0,IF(AD2-AC2,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   Report Post  
Old February 13th 18, 05:20 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2015
Posts: 869
Default 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="""","""",RC11-INT(RC11))"
Application.Index(rng, 0, 7) =
"=IF(RC15="""","""",IF(RC17RC15,RC17-RC15,RC15-RC17))"
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"",(RC17-RC16<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="""","""",RC9-1)"
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.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
  #4   Report Post  
Old February 13th 18, 05:34 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2015
Posts: 869
Default 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
'Project-specific 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.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
  #5   Report Post  
Old February 13th 18, 08:46 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2011
Posts: 3,566
Default 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="""","""",(J2-INT(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="""","""",$K2-INT($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="""","""",$I2-1)"
.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,U2-P2,U2-Q2)))"
.Cells(2, 31).Resize(LRow - 1).Formula = _
"=IF(W2<1,0,IF(AD2AC2,0,IF(AD2-AC2,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   Report Post  
Old February 14th 18, 12:27 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2012
Posts: 141
Default 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   Report Post  
Old February 14th 18, 12:31 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2015
Posts: 869
Default 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.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
  #8   Report Post  
Old February 14th 18, 12:34 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2015
Posts: 869
Default 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.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Performance Issue KS Excel Discussion (Misc queries) 1 March 22nd 10 06:06 PM
Performance issue Mike[_107_] Excel Programming 5 April 22nd 06 09:24 AM
Excel Performance issue Sandy Excel Discussion (Misc queries) 0 September 14th 05 01:50 PM
Performance Issue with Database Connection Ctal Excel Programming 4 August 16th 04 10:20 AM
Iteration performance issue J.Smith Excel Programming 4 June 24th 04 09:59 PM


All times are GMT +1. The time now is 08:58 AM.

Powered by vBulletin® Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Copyright 2004-2018 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Copyright © 2017