Excel Macro takes too much time to work

[riyajshaikh7]

Hi Guys , I need your help. I have made a macro to copy filtered data from one sheet to another. The pasted data is going to be used for updating one graph. But running the macro took more than a minute to run which seems too bad


Could you please suggest how I can improve this code:-


Public Sub UpdateGraph()


Application.StatusBar = "Updating Graph........Please Wait 5 Seconds!!!!!!"


Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.Calculation = xlCalculationManual


Sheets("Daily % LTOK data").Visible = True

Dim s As String

s = Sheets("Daily % LTOK data").Range("B2").Value

Sheets("Daily % LTOK data").Select

Range("$b$6:$d$60").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents

Range("$B$6").Select


Sheets("CP Monitoring").Select

ActiveSheet.Range("$E$8:$N$2500").AutoFilter Field:=1, Criteria1:=s

Range("$E$8:$G80").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Copy


Sheets("Daily % LTOK data").Select

Range("$B$5").Select

ActiveSheet.Paste


Sheets("CP Monitoring").Select


ActiveSheet.Range("$E$8:$N$5000").AutoFilter

Range("a1").Select


Sheets("Daily % LTOK").Select

Application.CutCopyMode = False

Sheets("Daily % LTOK data").Visible = False

Application.StatusBar = "Done !"

Application.ScreenUpdating = True

Application.DisplayAlerts = True


End Sub


Many thanks !

 

[Hui]

Riyajshaikh7


Firstly, Welcome to the Chandoo.org forums.


I'm interested in tackling this for you

Can you post a sample file, Refer: http://chandoo.org/forums/topic/posting-a-sample-workbook

 

[Krishnakumar]

Hi


Try to avoid Select, Activate etc. Dim proper variables.


See if this helps you.

[pre]

Public Sub UpdateGraph()

Dim wksLTOK     As Worksheet
Dim wksCP       As Worksheet
Dim LastRow     As Long
Dim s           As String
Dim rngToCopy   As Range
Dim lngCalc     As Long

With Application
.ScreenUpdating = False
.DisplayAlerts = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
End With

Set wksLTOK = Worksheets("Daily % LTOK data")
If Not wksLTOK.Visible Then wksLTOK.Visible = -1

s = wksLTOK.Range("B2").Value
wksLTOK.Range("$b$6:$d$60").ClearContents

LastRow = wksCP.Range("e" & wksCP.Rows.Count).End(xlUp).Row

With wksCP.Range("$E$8:$N$" & LastRow)
.AutoFilter Field:=1, Criteria1:=s
On Error Resume Next
Set rngToCopy = .Cells(1).Resize(.Rows.Count, 3).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rngToCopy Is Nothing Then
rngToCopy.Copy wksLTOK.Range("$B$5")
End If
.AutoFilter
End With

wksLTOK.Visible = 0

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = lngCalc
End With

End Sub

[/pre]

Kris