Copying Charts - Memory Leak - Excel 2003

S

sean_walsh

Hi

I have a s/s that has a VBA macro to set up a report with a whole
bunch of charts. But I'm getting a whole range of errors after I run
the macro 3/4 times. It appears as if there's a memory leak somewhere,
as in Task Manager I can see the memory taken up by Excel growing from
18 MB to 24MB to 30 MB after each run.

The macro clears the charting sheet before each run, so it shouldn't
be a problem.

Any ideas on why this is happening?

Thanks
Sean

CODE BELOW:
-----------------------------
Option Explicit
Sub CreateAllKPAGraphs()
Call CreateGraphsForKPA(1)
'Call CreateGraphsForKPA(2)
End Sub
Sub CreateGraphsForKPA(intKPA As Integer)
Dim strWorksheetName As String
strWorksheetName = "KPA " & intKPA

Call DeleteAllFromIndicatorsPage(strWorksheetName)

Dim intDataLineNumber As Integer, intGraphLineNumber As Integer
intDataLineNumber = 2
intGraphLineNumber = 1

Do While Worksheets("DATA_INDICATORS").Cells(intDataLineNumber, 1)
<> ""

' --- check if it's the rightKPA
If Worksheets("DATA_INDICATORS").Cells(intDataLineNumber, 1) =
intKPA Then
' --- new KPA row
If Worksheets("DATA_INDICATORS").Cells(intDataLineNumber,
2) = "0" Then
' --- add the KPA header
Call CreateKPALine(strWorksheetName,
intGraphLineNumber, intDataLineNumber)
intGraphLineNumber = intGraphLineNumber + 1

' --- new category row
ElseIf Worksheets("DATA_INDICATORS").Cells
(intDataLineNumber, 3) = "0" And Worksheets("DATA_INDICATORS").Cells
(intDataLineNumber, 2) <> "0" Then
' --- add the category header
Call CreateCategoryLine(strWorksheetName,
intGraphLineNumber, intDataLineNumber)
intGraphLineNumber = intGraphLineNumber + 1

' --- new graph
Else
' --- check the weight, dont add graph if <= 0
If Worksheets("DATA_INDICATORS").Cells
(intDataLineNumber, 8) > 0 Then
Call CreateComparisonGraph(strWorksheetName,
intGraphLineNumber, intDataLineNumber)
intGraphLineNumber = intGraphLineNumber + 12

End If

End If

End If

DoEvents
intDataLineNumber = intDataLineNumber + 1
Loop

End Sub

Sub CreateKPALine(strWorksheetName As String, intGraphLineNumber As
Integer, intDataLineNumber As Integer)
' --- copy row from template
Sheets("TEMPLATES").Rows("1:1").Copy
Sheets(strWorksheetName).Rows(intGraphLineNumber & ":" &
intGraphLineNumber).Insert Shift:=xlDown
Application.CutCopyMode = False

' --- set link to KPA name
Range("A" & (intGraphLineNumber) & ":F" &
(intGraphLineNumber)).FormulaR1C1 = "=DATA_INDICATORS!R" &
intDataLineNumber & "C5"

End Sub

Sub CreateCategoryLine(strWorksheetName As String, intGraphLineNumber
As Integer, intDataLineNumber As Integer)
' --- copy row from template
Sheets("TEMPLATES").Rows("2:2").Copy
Sheets(strWorksheetName).Rows(intGraphLineNumber & ":" &
intGraphLineNumber).Insert Shift:=xlDown
Application.CutCopyMode = False

' --- set link to Category name
Range("A" & (intGraphLineNumber) & ":F" &
(intGraphLineNumber)).FormulaR1C1 = "=DATA_INDICATORS!R" &
intDataLineNumber & "C5"

End Sub

Sub CreateComparisonGraph(strWorksheetName As String,
intGraphLineNumber As Integer, intDataLineNumber As Integer)
' --- copy graph from template
Sheets("TEMPLATES").Rows("3:14").Copy
Sheets(strWorksheetName).Rows(intGraphLineNumber & ":" &
intGraphLineNumber).Insert Shift:=xlDown
Application.CutCopyMode = False

' --- name the two new charts
Sheets(strWorksheetName).ChartObjects(Sheets
(strWorksheetName).ChartObjects.Count).Name = "Scoring " &
intDataLineNumber
Sheets(strWorksheetName).ChartObjects(Sheets
(strWorksheetName).ChartObjects.Count - 1).Name = "Comparative " &
intDataLineNumber

' --- indicator name
Range("A" & (intGraphLineNumber + 1) & ":C" & (intGraphLineNumber
+ 1)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C5"
' --- indicator values
Range("D" & (intGraphLineNumber + 1)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C9"
Range("E" & (intGraphLineNumber + 1)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C10"
Range("F" & (intGraphLineNumber + 1)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C8"
' --- formula
Range("A" & (intGraphLineNumber + 5) & ":D" & (intGraphLineNumber
+ 5)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C[14]"
' --- element 1
Range("A" & (intGraphLineNumber + 7) & ":B" & (intGraphLineNumber
+ 7)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C" &
16
Range("C" & (intGraphLineNumber + 7)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 17
Range("D" & (intGraphLineNumber + 7)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 18
' --- element 2
Range("A" & (intGraphLineNumber + 8) & ":B" & (intGraphLineNumber
+ 8)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C" &
19
Range("C" & (intGraphLineNumber + 8)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 20
Range("D" & (intGraphLineNumber + 8)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 21
' --- element 3
Range("A" & (intGraphLineNumber + 9) & ":B" & (intGraphLineNumber
+ 9)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C" &
22
Range("C" & (intGraphLineNumber + 9)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 23
Range("D" & (intGraphLineNumber + 9)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 24
' --- element 4
' Range("A" & (intGraphLineNumber + 10) & ":B" &
(intGraphLineNumber + 10)).FormulaR1C1 = "=DATA_INDICATORS!R" &
intDataLineNumber & "C" & 25
' Range("C" & (intGraphLineNumber + 10)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 26
' Range("D" & (intGraphLineNumber + 10)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 27

' --- comparative performance graph: source data
Windows(ActiveWorkbook.Name).Activate
DoEvents
Application.Worksheets(strWorksheetName).Activate
DoEvents
Sheets(strWorksheetName).ChartObjects("Comparative " &
intDataLineNumber).Activate
DoEvents
ActiveChart.SeriesCollection("OWN SCORE").XValues =
"=DATA_INDICATORS!R" & intDataLineNumber & "C10"
ActiveChart.SeriesCollection("CATEGORY AVERAGE").XValues =
"=DATA_INDICATORS!R" & intDataLineNumber & "C11"
ActiveChart.SeriesCollection("CATEGORY MEDIAN").XValues =
"=DATA_INDICATORS!R" & intDataLineNumber & "C12"
ActiveChart.SeriesCollection("CATEGORY RANGE").XValues =
"=DATA_INDICATORS!R" & intDataLineNumber & "C13:R" & intDataLineNumber
& "C14"
ActiveChart.Axes(xlPrimary).TickLabels.NumberFormat = "0%"
ActiveWindow.Visible = False

' --- scoring rules graph: source data
Windows(ActiveWorkbook.Name).Activate
DoEvents
Application.Worksheets(strWorksheetName).Activate
DoEvents
Sheets(strWorksheetName).ChartObjects("Scoring " &
intDataLineNumber).Activate
DoEvents
ActiveChart.SeriesCollection("POINT").XValues = "=DATA_INDICATORS!
R" & intDataLineNumber & "C10"
ActiveChart.SeriesCollection("POINT").Values = "=DATA_INDICATORS!
R" & intDataLineNumber & "C9"
ActiveChart.SeriesCollection("LINE").Values = "=DATA_INDICATORS!R"
& intDataLineNumber & "C28:R" & intDataLineNumber & "C30"
ActiveChart.SeriesCollection("LINE").XValues = "={0, .8, 1}"
' doesn't work
'ActiveChart.Axes(xlPrimary).NumberFormat = "0%"
ActiveWindow.Visible = False

End Sub

Sub DeleteAllFromIndicatorsPage(strWorksheetName)
Windows(ActiveWorkbook.Name).Activate
Application.Worksheets(strWorksheetName).Activate
Dim objChartObject As Excel.ChartObject
For Each objChartObject In Application.Worksheets
(strWorksheetName).ChartObjects
objChartObject.Activate
ActiveWindow.Visible = False
objChartObject.Delete
Next
Application.Worksheets(strWorksheetName).ChartObjects.Delete
Application.Worksheets(strWorksheetName).Cells.Select
Application.Worksheets(strWorksheetName).Cells.Clear
Application.Worksheets(strWorksheetName).Cells.RowHeight = 12.75
End Sub
 
J

Joel

I don't think deleteing ChartObject is a good idea. Y9ou can delete each
item, but not the entire collection. to release meory you can set object =
nothing.

from
objChartObject.Delete
to
objChartObject.Delete
set objChartObject = nothing

and remove this line from you code.
Application.Worksheets(strWorksheetName).ChartObjects.Delete
to


(strWorksheetName).ChartObjects
objChartObject.Activate
ActiveWindow.Visible = False
objChartObject.Delete
Next
Application.Worksheets(strWorksheetName).ChartObjects.Delete

sean_walsh said:
Hi

I have a s/s that has a VBA macro to set up a report with a whole
bunch of charts. But I'm getting a whole range of errors after I run
the macro 3/4 times. It appears as if there's a memory leak somewhere,
as in Task Manager I can see the memory taken up by Excel growing from
18 MB to 24MB to 30 MB after each run.

The macro clears the charting sheet before each run, so it shouldn't
be a problem.

Any ideas on why this is happening?

Thanks
Sean

CODE BELOW:
-----------------------------
Option Explicit
Sub CreateAllKPAGraphs()
Call CreateGraphsForKPA(1)
'Call CreateGraphsForKPA(2)
End Sub
Sub CreateGraphsForKPA(intKPA As Integer)
Dim strWorksheetName As String
strWorksheetName = "KPA " & intKPA

Call DeleteAllFromIndicatorsPage(strWorksheetName)

Dim intDataLineNumber As Integer, intGraphLineNumber As Integer
intDataLineNumber = 2
intGraphLineNumber = 1

Do While Worksheets("DATA_INDICATORS").Cells(intDataLineNumber, 1)
<> ""

' --- check if it's the rightKPA
If Worksheets("DATA_INDICATORS").Cells(intDataLineNumber, 1) =
intKPA Then
' --- new KPA row
If Worksheets("DATA_INDICATORS").Cells(intDataLineNumber,
2) = "0" Then
' --- add the KPA header
Call CreateKPALine(strWorksheetName,
intGraphLineNumber, intDataLineNumber)
intGraphLineNumber = intGraphLineNumber + 1

' --- new category row
ElseIf Worksheets("DATA_INDICATORS").Cells
(intDataLineNumber, 3) = "0" And Worksheets("DATA_INDICATORS").Cells
(intDataLineNumber, 2) <> "0" Then
' --- add the category header
Call CreateCategoryLine(strWorksheetName,
intGraphLineNumber, intDataLineNumber)
intGraphLineNumber = intGraphLineNumber + 1

' --- new graph
Else
' --- check the weight, dont add graph if <= 0
If Worksheets("DATA_INDICATORS").Cells
(intDataLineNumber, 8) > 0 Then
Call CreateComparisonGraph(strWorksheetName,
intGraphLineNumber, intDataLineNumber)
intGraphLineNumber = intGraphLineNumber + 12

End If

End If

End If

DoEvents
intDataLineNumber = intDataLineNumber + 1
Loop

End Sub

Sub CreateKPALine(strWorksheetName As String, intGraphLineNumber As
Integer, intDataLineNumber As Integer)
' --- copy row from template
Sheets("TEMPLATES").Rows("1:1").Copy
Sheets(strWorksheetName).Rows(intGraphLineNumber & ":" &
intGraphLineNumber).Insert Shift:=xlDown
Application.CutCopyMode = False

' --- set link to KPA name
Range("A" & (intGraphLineNumber) & ":F" &
(intGraphLineNumber)).FormulaR1C1 = "=DATA_INDICATORS!R" &
intDataLineNumber & "C5"

End Sub

Sub CreateCategoryLine(strWorksheetName As String, intGraphLineNumber
As Integer, intDataLineNumber As Integer)
' --- copy row from template
Sheets("TEMPLATES").Rows("2:2").Copy
Sheets(strWorksheetName).Rows(intGraphLineNumber & ":" &
intGraphLineNumber).Insert Shift:=xlDown
Application.CutCopyMode = False

' --- set link to Category name
Range("A" & (intGraphLineNumber) & ":F" &
(intGraphLineNumber)).FormulaR1C1 = "=DATA_INDICATORS!R" &
intDataLineNumber & "C5"

End Sub

Sub CreateComparisonGraph(strWorksheetName As String,
intGraphLineNumber As Integer, intDataLineNumber As Integer)
' --- copy graph from template
Sheets("TEMPLATES").Rows("3:14").Copy
Sheets(strWorksheetName).Rows(intGraphLineNumber & ":" &
intGraphLineNumber).Insert Shift:=xlDown
Application.CutCopyMode = False

' --- name the two new charts
Sheets(strWorksheetName).ChartObjects(Sheets
(strWorksheetName).ChartObjects.Count).Name = "Scoring " &
intDataLineNumber
Sheets(strWorksheetName).ChartObjects(Sheets
(strWorksheetName).ChartObjects.Count - 1).Name = "Comparative " &
intDataLineNumber

' --- indicator name
Range("A" & (intGraphLineNumber + 1) & ":C" & (intGraphLineNumber
+ 1)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C5"
' --- indicator values
Range("D" & (intGraphLineNumber + 1)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C9"
Range("E" & (intGraphLineNumber + 1)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C10"
Range("F" & (intGraphLineNumber + 1)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C8"
' --- formula
Range("A" & (intGraphLineNumber + 5) & ":D" & (intGraphLineNumber
+ 5)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C[14]"
' --- element 1
Range("A" & (intGraphLineNumber + 7) & ":B" & (intGraphLineNumber
+ 7)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C" &
16
Range("C" & (intGraphLineNumber + 7)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 17
Range("D" & (intGraphLineNumber + 7)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 18
' --- element 2
Range("A" & (intGraphLineNumber + 8) & ":B" & (intGraphLineNumber
+ 8)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C" &
19
Range("C" & (intGraphLineNumber + 8)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 20
Range("D" & (intGraphLineNumber + 8)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 21
' --- element 3
Range("A" & (intGraphLineNumber + 9) & ":B" & (intGraphLineNumber
+ 9)).FormulaR1C1 = "=DATA_INDICATORS!R" & intDataLineNumber & "C" &
22
Range("C" & (intGraphLineNumber + 9)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 23
Range("D" & (intGraphLineNumber + 9)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 24
' --- element 4
' Range("A" & (intGraphLineNumber + 10) & ":B" &
(intGraphLineNumber + 10)).FormulaR1C1 = "=DATA_INDICATORS!R" &
intDataLineNumber & "C" & 25
' Range("C" & (intGraphLineNumber + 10)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 26
' Range("D" & (intGraphLineNumber + 10)).FormulaR1C1 =
"=DATA_INDICATORS!R" & intDataLineNumber & "C" & 27

' --- comparative performance graph: source data
Windows(ActiveWorkbook.Name).Activate
DoEvents
Application.Worksheets(strWorksheetName).Activate
DoEvents
Sheets(strWorksheetName).ChartObjects("Comparative " &
intDataLineNumber).Activate
DoEvents
ActiveChart.SeriesCollection("OWN SCORE").XValues =
"=DATA_INDICATORS!R" & intDataLineNumber & "C10"
ActiveChart.SeriesCollection("CATEGORY AVERAGE").XValues =
"=DATA_INDICATORS!R" & intDataLineNumber & "C11"
ActiveChart.SeriesCollection("CATEGORY MEDIAN").XValues =
"=DATA_INDICATORS!R" & intDataLineNumber & "C12"
ActiveChart.SeriesCollection("CATEGORY RANGE").XValues =
"=DATA_INDICATORS!R" & intDataLineNumber & "C13:R" & intDataLineNumber
& "C14"
ActiveChart.Axes(xlPrimary).TickLabels.NumberFormat = "0%"
ActiveWindow.Visible = False

' --- scoring rules graph: source data
Windows(ActiveWorkbook.Name).Activate
DoEvents
Application.Worksheets(strWorksheetName).Activate
DoEvents
Sheets(strWorksheetName).ChartObjects("Scoring " &
intDataLineNumber).Activate
DoEvents
ActiveChart.SeriesCollection("POINT").XValues = "=DATA_INDICATORS!
R" & intDataLineNumber & "C10"
ActiveChart.SeriesCollection("POINT").Values = "=DATA_INDICATORS!
R" & intDataLineNumber & "C9"
ActiveChart.SeriesCollection("LINE").Values = "=DATA_INDICATORS!R"
& intDataLineNumber & "C28:R" & intDataLineNumber & "C30"
ActiveChart.SeriesCollection("LINE").XValues = "={0, .8, 1}"
' doesn't work
'ActiveChart.Axes(xlPrimary).NumberFormat = "0%"
ActiveWindow.Visible = False

End Sub

Sub DeleteAllFromIndicatorsPage(strWorksheetName)
Windows(ActiveWorkbook.Name).Activate
Application.Worksheets(strWorksheetName).Activate
Dim objChartObject As Excel.ChartObject
For Each objChartObject In Application.Worksheets
(strWorksheetName).ChartObjects
objChartObject.Activate
ActiveWindow.Visible = False
objChartObject.Delete
Next
Application.Worksheets(strWorksheetName).ChartObjects.Delete
Application.Worksheets(strWorksheetName).Cells.Select
Application.Worksheets(strWorksheetName).Cells.Clear
Application.Worksheets(strWorksheetName).Cells.RowHeight = 12.75
End Sub
Click to expand...
 
S

sean_walsh

Hi Joel, & thanks for your reply

I don't think it's got much to do with the deletes / Nothings. I
played around with your suggestions, but they didn't help.

Another reason why I think it's something else is, originally I was
going to create ALL my graphs on one worksheet. There are 80
"indicators" in 5 categories, and each indicator has 2 graphs. So
about 160 graphs in total. The reason why I mention the 5 Categories
is, originally I tried with the macro putting all the indicators &
graphs on a single worksheet, one after the other. At about Chart# 125
(IIRC), the processing would error, consistenly. I thought there might
be a limit to the number of charts per worksheet, so I decided to
split it up by Category...

So now, when it's split by category, I hit the same error when I've
run Category 1 about 3 times. I'm assuming I'm hitting the same
limitatation I was hitting earlier, only that in a Category - by -
Category basis, it's not happening in one go.

I can run it for Category 1, Save & Close, Open, Run it for Category
2, Save & Close, Open.... but that's not ideal !!!!

So my point is, there must be a limit to the number of Charts that I
can insert in a "session", as it errors on a clean workshee.

Thanks in advance....
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro to delete row if cells greater than certain value 1
display calculation next row 5
Macro autofills formula when a cell value is changed 4
Macro to Activate a Macro 6
MACRO Effeciency 3
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
VBA for Dependents shortcut menu 0
Using Collection to also capture range adjacent 10

Top