CODEWITHSUNDEEP
excelvbaoutlookout-of-memory
Symphony0084
Symphony0084

Reputation: 1435

Creating Charts via VBA - There isn't enough memory to complete this action

I have an Excel macro that creates a custom chart for each row.

My intention is to create about 50,000 charts each time I run the macro. I only get through about 3,000 - 5,000 before I hit the error:

"There isn't enough memory to complete this action. Try using less data or closing other applications. To increase memory availability, consider using a 64-bit version of Microsoft Excel."

In the beginning, the code creates about one chart every second. As it gets into the hundreds and then thousands, it slows down substantially.

Shortly before and during the crash, I can see from the Task Manager that only 10% of CPU and 15% of RAM are being utilized - nowhere near what I would think necessary to cause such a memory problem.

When I get the error, I typically save and close Excel, reopen the workbook, and then it runs fine again. So I put in a bit of code that stops every 1,000 charts and then saves the workbook before continuing. That didn't help at all.

A couple of notes about my system and setup:

The code follows:

Sub CHARTS()

'Turning off non-essential functions
Application.ScreenUpdating = False
Application.DisplayStatusBar = False

'Counting how many rows of data in the Import sheet
' (corresponding to how many charts are generated)
Dim lngRow As Long
lngRow = Worksheets("Import").Cells(Rows.Count, "A").End(xlUp).Row

'Variables to operate the macro
Dim Counter As Integer

'Variables to sub into the template
Dim DataField1 As String
Dim DataField2 As String
Dim DataField3 As String
Dim Recipient As String

'Variables to create and copy the custom chart
Dim DataObj As Shape
Dim objChart As chart
Dim folderpath As String
Dim picname As String
Dim ws As Worksheet
Dim chart As Picture

'Variables to Find & Replace in the template
Dim strFind As String
Dim strNew As String
Dim imgSrc As String

'Data starts at row 2, below headers... Goes to the last row of the sheet
For Counter = 2 To lngRow

    'Pulls the values from their cells in the Import sheet
    DataField1 = Worksheets("Import").Cells(Counter, 24)
    DataField2 = Worksheets("Import").Cells(Counter, 1)
    DataField3 = Worksheets("Import").Cells(Counter, 5)
    Recipient = Worksheets("Import").Cells(Counter, 17)

    'Pastes the values from into the Chart sheet to create the custom chart
    Worksheets("Chart").Cells(1, 2) = DataField1
    Worksheets("Chart").Cells(2, 2) = DataField2
    Worksheets("Chart").Cells(6, 2) = DataField3

    'Updates the chart area, since calculation is set to manual mode
    Worksheets("Chart").Columns("A:J").Calculate

    Set ws = Worksheets("Chart")

    'Locating & assigning current folder path of Excel file,
    ' then setting the name for the chart image based on DataField1
    folderpath = Application.ActiveWorkbook.Path & Application.PathSeparator
    picname = DataField1 & ".jpg"

    'Copying the chart range as an image
    ActiveWindow.DisplayGridlines = False
    On Error GoTo ErrHandler3:
    Call ws.Range("H6:AB26").CopyPicture(xlPrinter, xlPicture)

    'Creates a new sheet called Image, then adds the chart image,
    ' sets the height/width, then exports it to the folder with its name

    'creating a new sheet to insert the chart
    Worksheets.Add(after:=Worksheets(1)).Name = "Image"

    ActiveSheet.Shapes.AddChart.Select
    Set objChart = ActiveChart

    'making chart size match image range size
    ActiveSheet.Shapes.Item(1).Width = ws.Range("H6:AB26").Width

    ActiveSheet.Shapes.Item(1).Height = ws.Range("H6:AB26").Height
    objChart.Paste
    objChart.Export (folderpath & picname) 

    'Deletes the Image sheet
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete 'deleting sheet 'Image'
    Application.DisplayAlerts = True

Next Counter

'Turn back on essential functions
Application.ScreenUpdating = True
Application.DisplayStatusBar = True

'Send myself an email to let me know that its finished (I never get to this part)
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItemFromTemplate("C:\Users\Administrator\CHARTS\DONE.oft")
oMail.Send

MsgBox "Done"

End Sub

Upvotes: 1

Views: 538

Answers (3)

Symphony0084
Symphony0084

Reputation: 1435

I was never able to find a solution to the memory leak, so I switched to generating the charts in PHP instead of excel.

Upvotes: 0

Heslacher
Heslacher

Reputation: 2167

Place Set oApp = CreateObject("Outlook.Application") outside of the For loop.

Upvotes: 0

Ryan William Noon
Ryan William Noon

Reputation: 61

Put the DoEvents code in your for loop a few times.

https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/doevents-function

This should allow your processor to do some tasks, it'll make your code take a little longer but should avoid full memory situations :)

Upvotes: 0

Related Questions