locked
Memory usage of excel stays high after Macro is executed and excel crashes after trying to close it RRS feed

  • Question

  • Hi,

    I'm trying to resolve an issue with an excel based tool. The macros retrieve data from an Oracle database and do calculations with the data. They also open and write into files in the same directory. The macros all run and finish the calculations. I can continue to use and modify the sheet. I can also close the workbook, however excel memory usage I see in the windows Task manager stays elevated.If I  close Excel it says: Excel stopped working and then it tries to recover information...

    I assume something in the macro did not finish properly and memory was not released. I would like to check what is still open (connection, stream or any other object) when I close the workbook I would like to have a list of all still used memory. Is there a possibility to do so.

    Here the code I'm using, its reduced to functions which open something. Functions   

    get_v_tools() and get_change_tools() are same as get_client_positions().

    Public conODBC As New ADODB.Connection
    
    Public myPath As String
    
    Sub get_positions()
    
    Dim Src As range, dst As range
    Dim lastRow As Integer
    Dim myPath As String
    
    lastRow = Sheets("SQL_DATA").Cells(Sheets("SQL_DATA").rows.Count, "A").End(xlUp).Row
    
    Sheets("SQL_DATA").range("A2:AD" & lastRow + 1).ClearContents
    Sheets("SQL_DATA").range("AG2:BE" & lastRow + 2).ClearContents
    Sheets("SQL_DATA").range("AE3:AF" & lastRow + 2).ClearContents
    
    k = Sheets("ToolsList").Cells(Sheets("ToolsList").rows.Count, "A").End(xlUp).Row + 1
    
    Sheets("ToolsList").range("A2:M" & k).ClearContents
    
    'open connection
    Call open_connection
    
    
    lastRow = Sheets("SQL_DATA").Cells(Sheets("SQL_DATA").rows.Count, "A").End(xlUp).Row
    
    If lastRow < 2 Then GoTo ErrorHandling
    
    'copy bs price check multiplications
    Set Src = Sheets("SQL_DATA").range("AE2:AF2")
    Set dst = Worksheets("SQL_DATA").range("AE2").Resize(lastRow - 1, Src.columns.Count)
    dst.Formula = Src.Formula
    
    
    On Error GoTo ErrorHandling
    'new prices are calculated
    newPrice_calculate (lastRow)
    
    Calculate
    
    myPath = ThisWorkbook.Path
    'Refresh pivot table in Position Manager
     Sheets("Position Manager").PivotTables("PivotTable3").ChangePivotCache ActiveWorkbook. _
         PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
         myPath & "\[Position_Manager_v1.0.xlsm]SQL_DATA!R1C2:R" & lastRow & "C31" _
          , Version:=xlPivotTableVersion14)
    
    
    ErrorHandling:
    
    Set Src = Nothing
    Set dst = Nothing
    
    If conODBC.State <> 0 Then
        conODBC.Close
    End If
    
    End Sub
    
    Sub open_connection()
    
    Dim sql_data, sql_data_change, sql_data_v As Variant
    Dim wdth, TotalColumns, startRow As Integer
    Dim rst As New ADODB.Recordset
        
    Errorcode = 0
    
    On Error GoTo ErrorHandling
    
    Errorcode = 1
        With conODBC
            .Provider = "OraOLEDB.Oracle.1"
            .ConnectionString = "Password=" & pswrd & "; Persist Security Info=True;User ID= " & UserName & "; Data Source=" & DataSource
            .CursorLocation = adUseClient
            .Open
            .CommandTimeout = 300
        End With
    
    
    startRow = Sheets("SQL_DATA").Cells(Sheets("SQL_DATA").rows.Count, "A").End(xlUp).Row + 1
    
    sql_data = get_client_positions(conODBC, rst)
    wdth = UBound(sql_data, 1)
    
    Sheets("SQL_DATA").range("A" & startRow & ":AA" & wdth + startRow - 1).Value = sql_data
    
    'Run change tools instruments
    startRow = Sheets("ToolsList").Cells(Sheets("ToolsList").rows.Count, "A").End(xlUp).Row + 1
    
    sql_data_change = get_change_tools(conODBC, rst)
    wdth = UBound(sql_data_change, 1)
    
    Sheets("ToolsList").range("A" & startRow & ":M" & wdth + startRow - 1).Value _
    = sql_data_change
    
    'open SQL for V tools instruments
    
    startRow = Sheets("ToolsList").Cells(Sheets("ToolsList").rows.Count, "A").End(xlUp).Row + 1
    sql_data_v = get_v_tools(conODBC, rst)
    wdth = UBound(sql_data_v, 1)
    
    Sheets("ToolsList").range("A" & startRow & ":L" & startRow + wdth - 1).Value = sql_data_v
        
    conODBC.Close
    
    
    ErrorHandling:
    If rst.State <> 0 Then
        rst.Close
    End If
    
    Set rst = Nothing
    End Sub
    
    Private Function get_client_positions(conODBC As ADODB.Connection, rst_posi As ADODB.Recordset) As Variant
    Dim sql_data As Variant
    Dim objCommand As ADODB.Command
    Dim sql As String
    Dim records, TotalColumns As Integer
    
    On Error GoTo ErrorHandling
    
    Set objCommand = New ADODB.Command
    
        sql = read_sql()
        
    With objCommand
        .ActiveConnection = conODBC   'connection for the commands
        .CommandType = adCmdText
        .CommandText = sql         'Sql statement from the function
        .Prepared = True
        .CommandTimeout = 600
     End With
        Set rst_posi = objCommand.Execute
       
        TotalColumns = rst_posi.Fields.Count
        records = rst_posi.RecordCount
    
        ReDim sql_data(1 To records, 1 To TotalColumns)
    
        If TotalColumns = 0 Or records = 0 Then GoTo ErrorHandling
        
    
        If TotalColumns <> 27 Then GoTo ErrorHandling
    
    If rst_posi.EOF Then GoTo ErrorHandling
    
    l = 1
        Do While Not rst_posi.EOF
        For i = 0 To TotalColumns - 1
            
            sql_data(l, i + 1) = rst_posi.Fields(i)
            
        Next i
        
        l = l + 1
        rst_posi.MoveNext
        Loop
    
    ErrorHandling:
    rst_posi.Close
    Set rst_posi = Nothing
    Set objCommand = Nothing
    get_client_positions = sql_data
    
    End Function
    Private Function read_sql() As String
    Dim sqlFile As String, sqlQuery, Line  As String
    Dim query_dt As String, client As String, account As String
    
    Dim GRP_ID, GRP_SPLIT_ID As String
    Dim fso, stream As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
         
    client = Worksheets("Cover").range("C9").Value
    query_dt = Sheets("Cover").range("C7").Value
    GRP_ID = Sheets("Cover").range("C3").Value
    GRP_SPLIT_ID = Sheets("Cover").range("C5").Value
    account = Sheets("Cover").range("C11").Value
    sqlFile = Sheets("Cover").range("C15").Value
    
    Open sqlFile For Input As #1
    
    Do Until EOF(1)
        Line Input #1, Line
        sqlQuery = sqlQuery & vbCrLf & Line
    Loop
    Close
    
    ' Replace placeholders in the SQL
    sqlQuery = Replace(sqlQuery, "myClent", client)
    sqlQuery = Replace(sqlQuery, "01/01/9999", query_dt)
    sqlQuery = Replace(sqlQuery, "54747743", GRP_ID)
    If GRP_SPLIT_ID <> "" Then
    sqlQuery = Replace(sqlQuery, "7754843", GRP_SPLIT_ID)
    Else
    sqlQuery = Replace(sqlQuery, "AND POS.GRP_SPLIT_ID = 7754843", "")
    End If
    If account = "ZZ" Then
    sqlQuery = Replace(sqlQuery, "AND AC.ACCNT_NAME = 'ZZ'", "")
    Else
    sqlQuery = Replace(sqlQuery, "ZZ", account)
    End If
    
    ' Create a TextStream to check SQL Query
        sql = sqlQuery
        
        myPath = ThisWorkbook.Path
        Set stream = fso.CreateTextFile(myPath & "\SQL\LastQuery.txt", True)
    
        stream.Write sql
        stream.Close
    Set fso = Nothing
    Set stream = Nothing
    read_sql = sqlQuery
    
    End Function

    Monday, January 12, 2015 7:58 AM

All replies

  • You have declared the variable conODBC at the modul level, means the memory manager can not release this variable.

    Set the variable to Nothing at the end of your sub get_positions.

    Andreas.

    Monday, January 12, 2015 4:13 PM
  • Thanks for the Reply. However excel still crashes after closing it. Is there a way to check whats using up memory within excel itself?

    Mark

    Tuesday, January 13, 2015 3:33 PM
  • Hi kadimar,

    First, please disable screen updating and events. (At the end or in exception code, enable them)

    Application.ScreenUpdating=False

    Application.EnableEvents=False

    Secondly, there are some tools could analyze process, memory and so on that may help you:

    # Spy++

    http://msdn.microsoft.com/en-us/library/aa264396(v=vs.60).aspx  

    # Process Explorer

    http://technet.microsoft.com/en-us/sysinternals/bb896653.aspx

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Wednesday, January 14, 2015 3:01 AM
  • Thanks for the links,

    I tried to move conODBC from public into a Sub but still Excel keeps crashing after I close it although all steps of the macro execute fine and the sheet is fine and usable after the execution.

    Still have no clue whats wrong.

    Mark

    Friday, January 16, 2015 7:37 AM
  • Hi Mark,

    I think we need to narrow down this issue, please remove the object model code (leaving the OLEDB code, e.g. connect to database, retrieve data from database), then to check whether it still has the issue. If the issue has gone, then add part object model code at once, then check again.

    On the other hand, you may consider to use document-level add-in to achieve that if it needs to load too much large data.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Wednesday, January 21, 2015 6:33 AM
  • Thanks Starain,

    that's what I did the last days and found that the problem is in the

    newPrice_calculate (lastRow)

    function. This function retrieves data (sets it as arrays) which was correctly pasted into the sheet, loops through all rows and does math/calendar calculations with cell values using an Add-In("Quantlib")

    Public errorMessage as String
    
    Sub   newPrice_calculate(lastRow)
    
    Dim Type() As Variant
    Dim Id() As Variant
    Dim Price() As Variant
    Dim daysTo() As Variant
    Dim fx() As Variant
    Dim interest() As Variant
    Dim ObjCalend as Variant
    Dim newPrice as Variant
    
    On Error GoTo Catch
    
    interest = Sheets("SQL_DATA").range("V2:V" & lastRow).Value
    Type = Sheets("SQL_DATA").range("L2:L" & lastRow).Value Id = Sheets("SQL_DATA").range("M2:M" & lastRow).Value Price = Sheets("SQL_DATA").range("T2:T" & lastRow).Value
    daysTo = Sheets("SQL_DATA").range("K2:K" & lastRow).Value
    fx = Sheets("SQL_DATA").range("U2:U" & lastRow).Value
    qlError = 1
    For i = 2 To lastRow
    If (i, 1) = "LG" Then
    
    'set something - nothing spectacular like 
    interest(i, 1) = 0
    daysTo(i , 1) = 0
    '...
    Else
    adjTime = Sqr(daysTo(i, 1) / 365)
    ObjCalend(i,1) =Application.Run("qlCalendarHolidaysList", _
            "CalObj", ... , .... other input parameters)
    If IsError(ObjCalend(i,1)) Then GoTo Catch
    'other calendar calcs
    
    newPrice(i,1) = Application.Run( 'quantLib calcs)
    
    End If
    
    Catch:
    Select Case qlError
    Case 1
        errorMessage = errorMessage & " QuantLibXL Cal Error at: " & i & " " & vbNewLine & Err.Description
        ObjCalend(i,1) (i, 1) = "N/A"
    
    ...
    
    End Select
    Next i
    Sheets("SQL_DATA").range("AB2:AB" & lastRow).Value = newPrice
    'Sheets("SQL_DATA").range("AA2:AA" & lastRow).Value = daysTo
    
    ' erase and set to nothing all arrays and objects
    Erase Type
    Erase id
    Erase Price
    Set newPrice = Nothing
    ....

    Is there a possibility to clean everything in:

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    End Sub

    ?

    Thanks in advance

    Mark



    Wednesday, January 21, 2015 12:09 PM