ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Copying Charts - Memory Leak - Excel 2003 (https://www.excelbanter.com/excel-programming/425167-copying-charts-memory-leak-excel-2003-a.html)

sean_walsh
Copying Charts - Memory Leak - Excel 2003
 
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(intDataLineNum ber, 1)
< ""

' --- check if it's the rightKPA
If Worksheets("DATA_INDICATORS").Cells(intDataLineNum ber, 1) =
intKPA Then
' --- new KPA row
If Worksheets("DATA_INDICATORS").Cells(intDataLineNum ber,
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.NumberForma t = "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).ChartObje cts.Delete
Application.Worksheets(strWorksheetName).Cells.Sel ect
Application.Worksheets(strWorksheetName).Cells.Cle ar
Application.Worksheets(strWorksheetName).Cells.Row Height = 12.75
End Sub

joel
Copying Charts - Memory Leak - Excel 2003
 
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).ChartObje cts.Delete
to


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

"sean_walsh" wrote:

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(intDataLineNum ber, 1)
< ""

' --- check if it's the rightKPA
If Worksheets("DATA_INDICATORS").Cells(intDataLineNum ber, 1) =
intKPA Then
' --- new KPA row
If Worksheets("DATA_INDICATORS").Cells(intDataLineNum ber,
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.NumberForma t = "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).ChartObje cts.Delete
Application.Worksheets(strWorksheetName).Cells.Sel ect
Application.Worksheets(strWorksheetName).Cells.Cle ar
Application.Worksheets(strWorksheetName).Cells.Row Height = 12.75
End Sub

sean_walsh
Copying Charts - Memory Leak - Excel 2003
 
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....


All times are GMT +1. The time now is 07:04 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com