Releasing recursive class module in VBA

I've been playing around with a class module which contains multiple versions of itself to build up a tree structure.

I've noticed the process of building the tree is very fast. Roughly 2 seconds for a 7 level tree with 6-8 branches per subtree. Unfortunately the program runs very slowly. This seems to be caused by the release of the memory used by the tree, which takes at least 60 seconds.

Initially I did not release the class module, and allowed VB to do it at the end of the program, but replacing this with set myTree = nothing makes no difference to the speed.

I also tried writing a sub routine to destroy the tree. This recursively went through each layer and set the sub trees to nothing. Oddly this seemed to save aroung 0.5 of a second, but nothing significa开发者_StackOverflow中文版nt.

Is there anything else I can do to reduce the unload time?

The code is really long but the excert below gives the idea. I'm happy that the tree structure works, but the gap between the final two timer statements is very large

Class treeNode
     private aCurrentDepth as integer
     private aNodeObject as myObject
     private aNodes(maxNodeCount) as treeNode
end class

public function creatreTree(m as myObject,depth as integer) as treeNode
     Dim x As Integer

     Set createTree = New treeNode
     createTree.initialise

     createTree.cNodeObject = m
     createTree.cCurrentDepth = depth

     If depth <> 1 Then
          For x = 0 To maxNodeCount
                createTree.tNode(x) = createTree(getObject(m,x), depth - 1)
          Next x
     End If
end function

sub testTree
    Dim t as treeNode
    dim g as myObject
    Set t = New treeNode

    g.initialise
    t.initialise

    set g = startObject

    Cells(1, "A") = Timer
    Set t = createTree(g, 7)
    Cells(1, "B") = Timer
    Set t = Nothing
    Cells(1, "C") = Timer
end sub

I just created a debugExcelLog class last week. You might find it helpful to track what is happening in your classes. I used it to locate a bug that was happening only occasionally. (Turned out UserRoutine2 was trying to use a global class that UserRoutine1 was in the middle of clearing.)

'------------------------------------------------------------------------------
'| Class Name: debugExcelLog
'| Programmer: Mischa Becker
'|       Date: 11/4/2011
'|    Purpose: Creates an Excel Workbook log
'------------------------------------------------------------------------------
'| Notes:
'|   + Add a DEBUG_PROJECT compiler constant to your project
'|   + Add Public Const g_PROJECT_NAME As String = "[ProjectName]" to a module.
'|   + sName and sCalledBy are expected to be in one of the following formats:
'|             Project.Class.Routine
'|             Class.Routine
'|             Routine
'------------------------------------------------------------------------------
Option Explicit

Private Const m_CLASS_NAME As String = g_PROJECT_NAME & ".debugExcelLog"
Private Const m_OFFSET As Integer = 3

Private m_wbk As Workbook
Private m_r As Range
Private m_bLogged As Boolean
Private m_iIndent As Integer
Private m_bOkToLog As Boolean
Private m_lInstanceID As Long
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Private Sub Class_Initialize()
   m_bOkToLog = False
   m_lInstanceID = CLng(Rnd * 10 ^ 6)
   #If DEBUG_PROJECT Then
      Debug.Print m_CLASS_NAME; ".Class_Initialize", "Id:"; m_lInstanceID
      Me.TurnOn
   #End If
End Sub

Private Sub Class_Terminate()
   If Not (m_bLogged Or m_wbk Is Nothing) Then
      m_wbk.Close False
   End If
   Set m_wbk = Nothing
   Set m_r = Nothing
   #If DEBUG_PROJECT Then
      Debug.Print m_CLASS_NAME; ".Class_Terminate", "Id:"; m_lInstanceID
   #End If
End Sub
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Public Sub TurnOn()
   Set m_wbk = Application.Workbooks.Add
   Set m_r = m_wbk.Sheets(1).Range("A1")
   m_iIndent = 0
   SetTitle
   m_bOkToLog = True
End Sub

Public Sub TurnOff()
   m_bOkToLog = False
End Sub
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Public Sub Log_Start(sName As String, lInstance As Long _
, Optional sCalledBy As String = "" _
, Optional sComment As String = "")
   Const MY_NAME As String = m_CLASS_NAME & ".Log_Start"
   On Error GoTo ErrorHandler

   If Not m_bOkToLog Then Exit Sub

   m_bLogged = True
   m_iIndent = m_iIndent + 1

   BreakApartAndLogName sName, ".Start"
   Instance = lInstance
   TimeStamp = Now
   CalledBy = sCalledBy
   Comment = sComment

   MoveNextRow

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub

Public Sub Log_End(sName As String, lInstance As Long _
, Optional sCalledBy As String = "" _
, Optional sComment As String = "")
   Const MY_NAME As String = m_CLASS_NAME & ".Log_End"
   On Error GoTo ErrorHandler

   If Not m_bOkToLog Then Exit Sub

   BreakApartAndLogName sName, ".End"
   Instance = lInstance
   TimeStamp = Now
   CalledBy = sCalledBy
   Comment = sComment

   MoveNextRow

   m_iIndent = m_iIndent - 1

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub

Public Sub Log_Other(sName As String, lInstance As Long _
, Optional sCalledBy As String = "" _
, Optional sComment As String = "")
   Const MY_NAME As String = m_CLASS_NAME & ".Log_Other"
   On Error GoTo ErrorHandler

   If Not m_bOkToLog Then Exit Sub
   m_bLogged = True
   If m_iIndent < 0 Then m_iIndent = 0

   BreakApartAndLogName sName
   Instance = lInstance
   TimeStamp = Now
   CalledBy = sCalledBy
   Comment = sComment

   MoveNextRow

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Private Sub SetTitle()
   Const MY_NAME As String = m_CLASS_NAME & ".SetTitle"
   On Error GoTo ErrorHandler

   m_r = "Debug Excel Log Created on " & Date
   MoveNextRow
   Project = "Project"
   Module = "Module"
   Routine = "Routine"
   Instance = "Instance"
   TimeStamp = "TimeStamp"
   CalledBy = "Called By"
   Comment = "Comment"
   With Range(m_r, m_r.End(xlToRight))
      .Font.Bold = True
      .BorderAround XlLineStyle.xlContinuous, xlMedium
   End With
   MoveNextRow
   m_iIndent = -1

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub

Private Sub MoveNextRow()
   Set m_r = m_r.Offset(1)
End Sub

Private Sub BreakApartAndLogName(ByVal sName As String _
, Optional sExtra As String = "")
   Const MY_NAME As String = m_CLASS_NAME & ".BreakApartAndLogName"
   On Error GoTo ErrorHandler

   Routine = SplitOffLastSection(sName) & sExtra
   If Len(sName) > 0 Then
      Module = SplitOffLastSection(sName)
      If Len(sName) > 0 Then
         Project = SplitOffLastSection(sName)
      End If
   End If

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub

Private Function SplitOffLastSection(ByRef sName As String) As String
' Passed sName is returned without the Last Section.
   Const MY_NAME As String = m_CLASS_NAME & ".SplitOffLastSection"
   Dim i As Integer

   i = InStrRev(sName, ".")
   If i > 0 Then
      SplitOffLastSection = Mid(sName, i + 1)
      sName = Left(sName, i - 1)
   Else
      SplitOffLastSection = sName
      sName = ""
   End If

   Exit Function
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Function
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Private Property Let Project(sText As String)
   m_r = sText
End Property
Private Property Get Project() As String
   Project = m_r.Text
End Property

Private Property Let Module(sText As String)
   m_r.Offset(0, 1) = sText
End Property
Private Property Get Module() As String
   Module = m_r.Offset(0, 1).Text
End Property

Private Property Let Routine(sText As String)
   If m_iIndent < 0 Then
      m_r.Offset(0, 2) = sText
   Else
      m_r.Offset(0, 2) = Space(m_OFFSET * m_iIndent) & sText
   End If
End Property

Private Property Let Instance(lInstance As Variant)
   m_r.Offset(0, 3) = lInstance
End Property

Private Property Let TimeStamp(dTimeStamp As Variant)
   m_r.Offset(0, 4) = dTimeStamp
End Property

Private Property Let CalledBy(ByVal sText As String)
   ' remove Project and Module from sText if same as running Routine
   sText = Replace(sText, Project & "." & Module & ".", "")
   sText = Replace(sText, Project & ".", "")
   m_r.Offset(0, 5) = sText
End Property

Private Property Let Comment(sText As String)
   m_r.Offset(0, 6) = sText
End Property
'------------------------------------------------------------------------------

To use:

1. Add the class to your project and name it debugExcelLog
2. Add DEBUG_PROJECT=-1 as a conditional compiler constant to your project
3. Create a global variable of the class. ie Public g_XlLog As debugExcelLog

4. Logging can be turned on and off with

   g_xlLog.TurnOn
   g_xlLog.TurnOff
   

   If DEBUG_PROJECT is True, you don't need to call TurnOn, the class will auto turn on when it initializes.

5. Use the following in any routine you want to track.

   g_XlLog.Log_Start "[Class.Routine]", m_lInstanceIdOrZero
   g_XlLog.Log_Other "[Class.Routine]", m_lInstanceIdOrZero, ,"Comment"
   g_XlLog.Log_End   "[Class.Routine]", m_lInstanceIdOrZero
   

6. I suggest altering your testTree as follows.

   sub testTree
       Dim t as treeNode, g as myObject
       Dim iLevel as Integer
   
       iLevel = 7
       Set g_XlLog = New debugExcelLog
   
       g_XlLog.Log_Start "testTree", 0, , "Initializing test variables"
   
       Set t = New treeNode
       g.initialise
       t.initialise
   
       set g = startObject
   
       g_XlLog.Log_Other "testTree", 0, , "Create a " & iLevel & " level tree"
       Set t = createTree(g, iLevel)
       g_XlLog.Log_Other "testTree", 0, , "Terminate a " & iLevel & " level tree"
       Set t = Nothing
       g_XlLog.Log_End "testTree", 0
   
       set g_XlLog = Nothing
   
   end sub
   

I would recommend adding logging to Class_Initialize and Class_Terminate for both treeNode and MyObject. If Class_Terminate is calling other routines you can either add logging to them, or use Log_Other to track when each one starts.

If you haven't done so already, I really recommend adding some sort of instance id to treeNode so you will know which instance is being created\terminated. If you aren't worried about Rnd creating duplicate IDs it can be as simple as what I have in the above class.

You will also notice the optional sCalledBy and sComment parameters. sComment should be obvious but sCalledBy is there because the Excel VBE's Call Stack leaves a lot to be desired. For debugging purposes, some of my methods require the routine calling them to pass their name in as a parameter. If you have this info, you can send it to the logger.

Once you have a more precise idea of where the slow-down is happening, it will be a lot easier to figure out how to fix it.