View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
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