Suggestion for improving the execution time

[Avi]

Hi All,

Please suggest if the following code can be optimed w.r.to execution
time. Currently lines 6,7,8,13,14,15 are taking almost 1 sec each to
execute. is there a way to optimize.
This is just one of my modules and kinda bottle neck in my code, so i
was looking for a better way to write the code.

Kindly help,
Avinash

1 Sub updateHeaders()
2 Calculate
3 Set currentSheet = Sheets("DashBoard")
4
5 With currentSheet
6 .Range("B2").Value = "SCTT TESTING METRICS"
7 .Range("B5").Value = Format(Range("Project"), "MMM-YYYY")
8 .Range("B6").Value = "OPEN DEFECTS " &
Range("rngOPenDefectCount")
9 .Range("B8").Select
10 With Selection
11 If Range("rngOPenDefectCount") <> 0 Then
12 .Value = "D [days] | W [weeks] |M [months] |
Q[quarter]"
13 .HorizontalAlignment = xlRight
14 .VerticalAlignment = xlBottom
15 .Font.size = 8
16 Else
17 .Value = "There are no Open Defects"
18 .HorizontalAlignment = xlLeft
19 .VerticalAlignment = xlTop
20 .Font.size = 14
21 Sheets("DashBoard").DrawingObjects.delete
22 End If
23 End With
24 .Range("B76").Value = "last updated on " & Format(Now() -
TimeValue("12:30:00"), "mm/dd/yyyy hh:mm:ss AMPM")
25 End With
26 End Sub

 

[Don Guillett]

You may want to turn off calculation and screen updating and eliminate
selections.
calculation=xlManual
application.screenupdating=false
code
calculation=xlautomatic'Manual
application.screenupdating=true'false

 

[Avi]

Thanks for the reply Don. I made the suggested changes and there is
some improvement though not significant.

You may want to turn off calculation and screen updating and eliminate
selections.
calculation=xlManual
application.screenupdating=false
code
calculation=xlautomatic'Manual
application.screenupdating=true'false

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

Hi All,

Please suggest if the following code can be optimed w.r.to execution
time. Currently lines 6,7,8,13,14,15 are taking almost 1 sec each to
execute. is there a way to optimize.
This is just one of my modules and kinda bottle neck in my code, so i
was looking for a better way to write the code.

Kindly help,
Avinash

1 Sub updateHeaders()
2     Calculate
3     Set currentSheet = Sheets("DashBoard")
4
5     With currentSheet
6         .Range("B2").Value = "SCTT TESTING METRICS"
7         .Range("B5").Value = Format(Range("Project"), "MMM-YYYY")
8         .Range("B6").Value = "OPEN DEFECTS  " &
Range("rngOPenDefectCount")
9         .Range("B8").Select
10         With Selection
11             If Range("rngOPenDefectCount") <> 0 Then
12                 .Value = "D [days] | W [weeks] |M [months] |
Q[quarter]"
13                 .HorizontalAlignment = xlRight
14                 .VerticalAlignment = xlBottom
15                 .Font.size = 8
16             Else
17                 .Value = "There are no Open Defects"
18                 .HorizontalAlignment = xlLeft
19                 .VerticalAlignment = xlTop
20                 .Font.size = 14
21                 Sheets("DashBoard").DrawingObjects.delete
22             End If
23         End With
24         .Range("B76").Value = "last updated on " & Format(Now() -
TimeValue("12:30:00"), "mm/dd/yyyy hh:mm:ss AMPM")
25     End With
26 End Sub

 

[Don Guillett]

Your xlversion___________?
If desired, send your workbook to my address below and I will take a look.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Thanks for the reply Don. I made the suggested changes and there is
some improvement though not significant.

You may want to turn off calculation and screen updating and eliminate
selections.
calculation=xlManual
application.screenupdating=false
code
calculation=xlautomatic'Manual
application.screenupdating=true'false

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

Hi All,

Please suggest if the following code can be optimed w.r.to execution
time. Currently lines 6,7,8,13,14,15 are taking almost 1 sec each to
execute. is there a way to optimize.
This is just one of my modules and kinda bottle neck in my code, so i
was looking for a better way to write the code.

Kindly help,
Avinash

1 Sub updateHeaders()
2 Calculate
3 Set currentSheet = Sheets("DashBoard")
4
5 With currentSheet
6 .Range("B2").Value = "SCTT TESTING METRICS"
7 .Range("B5").Value = Format(Range("Project"), "MMM-YYYY")
8 .Range("B6").Value = "OPEN DEFECTS " &
Range("rngOPenDefectCount")
9 .Range("B8").Select
10 With Selection
11 If Range("rngOPenDefectCount") <> 0 Then
12 .Value = "D [days] | W [weeks] |M [months] |
Q[quarter]"
13 .HorizontalAlignment = xlRight
14 .VerticalAlignment = xlBottom
15 .Font.size = 8
16 Else
17 .Value = "There are no Open Defects"
18 .HorizontalAlignment = xlLeft
19 .VerticalAlignment = xlTop
20 .Font.size = 14
21 Sheets("DashBoard").DrawingObjects.delete
22 End If
23 End With
24 .Range("B76").Value = "last updated on " & Format(Now() -
TimeValue("12:30:00"), "mm/dd/yyyy hh:mm:ss AMPM")
25 End With
26 End Sub