Really Slow Running of Macro

[John]

I have a macro (detailed below) which is really slow at running, approx 10
mins, but doesnt have a substantial amount of information. Should I be
turning off Caluculation within it or will it effect some of the formulas I
add within the macro?


Sub GoToFigures()

Format_Query

Sheets("Database2").Visible = True
Sheets("Database2").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Range("A1").Select
Application.ScreenUpdating = False

With Application
.Calculation = xlManual
.MaxChange = 0.001
End With

Sheets("Database2").Select

Range("A1").Select


Columns("B:B").Select
Application.CutCopyMode = False
Selection.NumberFormat = "DD/MM/YY"


Range("N2").Select

ActiveCell.Formula =
"=IF(ISNA(MATCH(A2,StaffNo,0)),""Crew"",INDEX(StaffGrade,MATCH(A2,StaffNo,0)))"

Range("N2.N2").Copy
x = 2
Do Until Cells(x, 1).Value = ""
Cells(x, 14).PasteSpecial xlPasteFormulas
x = x + 1
Loop

With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = True

Sheets("Database2").Select
Range("A1").Select
ActiveWindow.SelectedSheets.Visible = False



With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = True



Sheets("Database3").Visible = True
Sheets("Database3").Select
Sheets("Database3").Select
ActiveSheet.Unprotect Password:="pass"

Cells.Select
Selection.ClearContents
Range("A1").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Range("A1").Select
Application.ScreenUpdating = False

With Application
.Calculation = xlManual
.MaxChange = 0.001
End With


Range("B11").Select

Range("A1").Select


With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = True

Sheets("Database3").Select
Range("A1").Select
ActiveWindow.SelectedSheets.Visible = False



With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = True

EmployeeNumbers

Sheets("Figures").Select

ActiveSheet.Protect Password:="pass", DrawingObjects:=True,
Contents:=True, Scenarios:=True
Range("B11").Select
Range("B11").Select
End Sub

 

[Toppers]

John,

What do macros "Format_Query" and "EmployeeNumbers" do ... as
these could be the problem?

Also in your code there appears to be lots of redundancy ... unnecessary
Selects etc.

This is my interrpretation of your code UNTESTED (but I could be wrong!):

Sub GoToFigures()

Format_Query

Sheets("Database2").Activate
With Sheets("Database2")
.Visible = True
.Cells.ClearContents
.Range("A1").QueryTable.Refresh BackgroundQuery:=False
.Columns("B:B").NumberFormat = "DD/MM/YY"
lastrow = .Cells(Rows.Count, "N").End(xlUp).Row
.Range("N2").Resize(lastrow - 1,1).Formula =
"=IF(ISNA(MATCH(A2,StaffNo,0)),""Crew"",INDEX(StaffGrade,MATCH(A2,StaffNo,0)))"
End With

Application.ScreenUpdating = False


With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With

ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = True


Sheets("Database3").Activate
ActiveSheet.Unprotect Password:="pass"
With Sheets("Database3")
.Visible = True
.Cells.ClearContents
.Range("A1").QueryTable.Refresh BackgroundQuery:=False
End With

EmployeeNumbers

Sheets("Figures").Activate

ActiveSheet.Protect Password:="pass", DrawingObjects:=True,
Contents:=True, Scenarios:=True

End Sub

 

[John]

Thanks Topper

I'm a novice, so I tend just to record, hence redundancy. Format Query
pretty much only formats columns n a worksheet called Database. Visually
what remains on the screen for quite awhile is Database2, so I'm guessing
the formula below maybe the time consuming bit, although it only goes
through 200 rows of data or so, which doesn't seem much

ActiveCell.Formula =
"=IF(ISNA(MATCH(A2,StaffNo,0)),""Crew"",INDEX(StaffGrade,MATCH(A2,StaffNo,0)))"

Range("N2.N2").Copy
x = 2
Do Until Cells(x, 1).Value = ""
Cells(x, 14).PasteSpecial xlPasteFormulas
x = x + 1
Loop

 

[Toppers]

John,
You will see I changed how the formla was inserted into the cells
but the execution for 200 rows shouldn't take much time. If you can't solve
it, you can send me the workbook and I'll have a look at it.
([email protected])

HTH