Macro Excel running very slow

[Waenner]

Hi All,

I have an excel macro, which is running fast to begin with and then slows down.
It is excel 2003 and the macro does as follows

Refreshes 17 pivot tables.

Then publishes data to .html - 64 sheets.

Change parameters and publish 64 sheets again.

All in all it publishes 640 sheets and changes parameters 10 time.

At the start it publishes 89 per min. but then it slows down. when around 500 sheets it takes 5-10 min to publish a sheet!

I hope you have some ideas?

Best Regards,

Bo

 

[Derek Brown]

Hello and welcome to The Board.
Could the macro not be releasing resources during the processing (sort of running out of available memory)?
Have you tried monitoring memory usage using Task Manager?
Are you controlling re-calculation or is it set to automatic?
Someone may be able to provide some help if you are able to post the macro code.

 

[Michael M]

Also
Maybe you need to clear the clipboard after a set of activities
Have a look here for information on how to do that

http://www.cpearson.com/excel/clipboard.htm

 

[Waenner]

Hi Both,

I will try monitoring the avaliabe ressouces for the CPU, but it should not be a problem.

Please see below the code...

Sub StartMacro()

Application.ScreenUpdating = False

'Open and refresh Period File

Workbooks.Open Filename:= _
"L:\DataFiles\General Info\Production Periods\Period - Month - Summary OLS.xls"
ActiveWorkbook.Save
ActiveWindow.Close

Workbooks.Open Filename:= _
"L:\DataFiles\General Info\Production Periods\Period - Week - Summary OLS.xls"
ActiveWorkbook.Save
ActiveWindow.Close

Dim MaxCount1 As Variant
Dim Piv_Table As Variant

'Set counters to zero

Sheets("Tables").Activate
Worksheets("Tables").Range("Counter0").Select
Set Counter0 = ActiveCell
ActiveCell.Value = 0

Sheets("Tables").Activate
Worksheets("Tables").Range("Counter1").Select
Set Counter1 = ActiveCell
ActiveCell.Value = 0

Sheets("Tables").Activate
Worksheets("Tables").Range("Counter2").Select
Set Counter2 = ActiveCell
ActiveCell.Value = 0

Sheets("Tables").Activate
Worksheets("Tables").Range("Counter3").Select
Set Counter3 = ActiveCell
ActiveCell.Value = 0


'Refresh all Pivot Tables and "Country" to "ALL"

'Tranfer variables to VB

Sheets("Tables").Select
Worksheets("Tables").Range("Max_Counter1").Select
Set Max_Counter1 = ActiveCell
MaxCount1 = ActiveCell.Value

For Count1 = 1 To MaxCount1 Step 1

Sheets("Tables").Select
Worksheets("Tables").Range("Piv_Name").Select
Set Piv_Name = ActiveCell
Piv_Table = ActiveCell.Value

Sheets("Pivot Data").Activate
ActiveSheet.PivotTables(Piv_Table).RefreshTable
ActiveSheet.PivotTables(Piv_Table).PivotFields("Country").CurrentPage = "(All)"

Sheets("Tables").Select
Worksheets("Tables").Range("Counter1").Select
Set Counter1 = ActiveCell
ActiveCell.Value = ActiveCell.Value + 1

Next Count1

'Save file

Sheets("Tables").Activate
Worksheets("Tables").Range("A1").Select
ActiveWorkbook.Save


'Publish Budget then Forecast as "Target"

Publish


Application.ScreenUpdating = True
Workbooks("Weekly Summary OLS.xls").Close SaveChanges:=False


End Sub
Sub Publish()

Dim MaxCount0 As Variant
Dim MaxCount2 As Variant

'Transfer variables from Excel to VB

Sheets("Tables").Select
Worksheets("Tables").Range("Max_Counter2").Select
Set Max_Counter2 = ActiveCell
Max_Count2 = ActiveCell.Value

For count2 = 1 To Max_Count2 Step 1

'Update Location / Country

Location

'Export with Budget and if available Forecast

'Transfer variables from Excel to VB

Sheets("Tables").Select
Worksheets("Tables").Range("Max_Counter0").Select
Set Max_Counter0 = ActiveCell
MaxCount0 = ActiveCell.Value

'set counter to zero

Sheets("Tables").Activate
Worksheets("Tables").Range("Counter0").Select
Set Counter0 = ActiveCell
ActiveCell.Value = 0


For count0 = 1 To MaxCount0 Step 1

Export

Sheets("Tables").Select
Worksheets("Tables").Range("Counter0").Select
Set Counter0 = ActiveCell
ActiveCell.Value = ActiveCell.Value + 1

Next count0

Sheets("Tables").Select
Worksheets("Tables").Range("Counter2").Select
Set Counter2 = ActiveCell
ActiveCell.Value = ActiveCell.Value + 1

Next count2

End Sub
Sub Location()

Dim Piv_Ref As Variant
Dim Piv_Ctry As String

'Set counter to zero

Sheets("Tables").Activate
Worksheets("Tables").Range("Counter1").Select
Set Counter1 = ActiveCell
ActiveCell.Value = 0

'Transfer variable from Excel to VB

Sheets("Tables").Select
Worksheets("Tables").Range("Max_Counter1").Select
Set Max_Counter1 = ActiveCell
Max_Count1 = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("Pivot_ctry").Select
Set Pivot_ctry = ActiveCell
Piv_Ctry = ActiveCell.Value

'Set Country and Pivot Table Names

For Count1 = 1 To Max_Count1 Step 1

Sheets("Tables").Select
Worksheets("Tables").Range("Piv_Name").Select
Set Piv_Name = ActiveCell
Piv_Ref = ActiveCell.Value

'Update Pivot Country

Sheets("Pivot Data").Activate
ActiveSheet.PivotTables(Piv_Ref).PivotFields("Country").CurrentPage = Piv_Ctry

'Add 1 to the counter

Sheets("Tables").Select
Worksheets("Tables").Range("Counter1").Select
Set Counter1 = ActiveCell
ActiveCell.Value = ActiveCell.Value + 1

Next Count1

End Sub
Sub Export()

Dim Folder As Variant
Dim Location As Variant
Dim Sheet As Variant
Dim HTML As Variant
Dim count3 As Variant
Dim Max_Count3 As Variant
Dim Graph_Selector As Variant
Dim Graph1_name As Variant
Dim Graph1_min As Variant
Dim Graph1_max As Variant
Dim Graph2_name As Variant
Dim Graph2_min As Variant
Dim Graph2_max As Variant

'Transfer variable from Excel to VB

Sheets("Tables").Select
Worksheets("Tables").Range("Folder_Name").Select
Set Folder_Name = ActiveCell
Folder = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("Name").Select
Set Name = ActiveCell
Location = ActiveCell.Value

'Set counter to zero

Sheets("Tables").Activate
Worksheets("Tables").Range("Counter3").Select
Set Counter3 = ActiveCell
ActiveCell.Value = 0

'Run Loop to Export Sheets and HTML Name

'Transfer variable from Excel to VB

Sheets("Tables").Select
Worksheets("Tables").Range("Max_Counter3").Select
Set Max_Counter3 = ActiveCell
Max_Count3 = ActiveCell.Value

For count3 = 1 To Max_Count3 Step 1

'Transfer variable from Excel to VB

Sheets("Tables").Select
Worksheets("Tables").Range("Sheet_Name").Select
Set Sheet_Name = ActiveCell
Sheet = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("HTML_Name").Select
Set HTML_Name = ActiveCell
HTML = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("Counter3").Select
Set Counter3 = ActiveCell
count3 = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("Graphs").Select
Set Graphs = ActiveCell
Graph_Selector = ActiveCell.Value

If Graph_Selector = "Yes" Then

'Transfer variable from Excel to VB

Sheets("Tables").Select
Worksheets("Tables").Range("Graph_Name1").Select
Set Graph_Name1 = ActiveCell
Graph1_name = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("Min_1").Select
Set Min_1 = ActiveCell
Graph1_min = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("Max_1").Select
Set Max_1 = ActiveCell
Graph1_max = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("Graph_Name2").Select
Set Graph_Name2 = ActiveCell
Graph2_name = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("Min_2").Select
Set Min_2 = ActiveCell
Graph2_min = ActiveCell.Value

Sheets("Tables").Select
Worksheets("Tables").Range("Max_2").Select
Set Max_2 = ActiveCell
Graph2_max = ActiveCell.Value

'Update charts

Sheets(Sheet).Select
Worksheets(Sheet).ChartObjects.Item(Graph1_name).Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = Graph1_min
.MaximumScale = Graph1_max
End With

If Graph2_name <> "n/a" Then

Sheets(Sheet).Select
Worksheets(Sheet).ChartObjects.Item(Graph2_name).Activate
With ActiveChart.Axes(xlValue)
.MinimumScale = Graph2_min
.MaximumScale = Graph2_max
End With
Else
End If

Sheets("Tables").Select
Worksheets("Tables").Range("A1").Select

Else

End If

' Publish (save web page)

With ActiveWorkbook _
.PublishObjects.Add( _
xlSourceSheet, _
"L:\Reports\Intranet\Files\" & _
Folder & "\" & _
Location & "\" & _
HTML, _
Sheet, _
"B2:T21", _
xlHtmlStatic)
.Publish (True)
End With

Sheets("Tables").Select
Worksheets("Tables").Range("Counter3").Select
Set Counter3 = ActiveCell
ActiveCell.Value = ActiveCell.Value + 1

Next count3

End Sub

I hope you are able to help me.

Thanks for your kind assistance so far

BR

Bo Wænnerstrøm

 

[Norie]

One thing you could do is get rid of all the Select/ActiveCell stuff.

For example, this:

Sheets("Tables").Activate
Worksheets("Tables").Range("Counter0").Select
Set Counter0 = ActiveCell
ActiveCell.Value = 0

Can be replaced with this:

Worksheets("Tables").Range("Counter0").Value = 0

That sort of thing might not make a lot if difference but you never know.

I'm sure there are other things that can be done to speed things up.

By the way, why do you open and close the 2 period files at the beginning of the code?

Are they connected to the pivot tables?

PS What's in the range Max_Counter1?