Tracking down "Out of Memory" error

hi,

I am dealing with a macro that works with a large number of user-defined objects (milestones on a schedule)
recently, "Out of Memory" keeps coming, but I don't know its origin, nor how to solve it

what steps should I follow?

I see that function INFO("memused") is no longer available...

all help appreciated!

You could start by posting your code.

Have you even identified the sub/function it occurs in?

Hi Sixthsense,

I do have a couple of UDF, but they are used just to recalculate a number of cells and then are converted to values, so I asume the problem is not there... am I right?

Kyle123, I really don't know where the problem is -- it appears after running this macro, but the problem may be in the books it opens

'import global extract made with macros (has valid data sheet)
Option Explicit

Dim EXTRACTwb As Workbook
Dim EXTRACTws As Worksheet

Dim prjTitle As String

Dim xRows As Range
Dim xRowsA As Range
Dim xRow As Range

Dim DATAr As Range
Dim foundDATAr As Range

Dim xRowWithChanges() As Variant
Dim DATArWithChanges() As Variant
Dim changesType() As Variant

Dim newXrows() As Variant
Dim deletedDataRows() As Variant

Dim itemCount As Integer
Dim i As Integer

Dim frm As manageMLS2Import

Enum milestoneComparison
    mcNew = 0
    mcnewinclude = 1
    mcNewunInclude = 2
    mcDateChanges = 3
    mcDeleted = 4
    mcAllOK = 5
    mcNA = 6
End Enum

'2015-03-26 / B.Agullo /
Public Sub importFromGlobalExtractM()
'import extract made with macros (has valid data sheet)
    
    Dim awb As Workbook
    
    Set awb = ActiveWorkbook
    If Not initImportExtractM Then GoTo release

    Call checkChangesInDataSheet
    
    Call showMilestoneChanges
    
    If formCancel Then GoTo release
    
    Call processAcceptedMilestoneChanges
    
    Call closeGPTMS
    
    awb.Activate
    
release:
    
    On Error Resume Next
    EXTRACTwb.Close savechanges:=False
    Set EXTRACTwb = Nothing
    Set EXTRACTws = Nothing
    Set frm = Nothing
    On Error GoTo 0
    
    If isAnswerOk("Refresh Render to see all changes?") Then
        Call renderSchedule(awb)
    End If
    
    Set awb = Nothing
    
End Sub


'2015-03-26 / B.Agullo /
Public Function initImportExtractM() As Boolean
'open global extract with macros and initialize required variables and assure is a valid file

    Dim filename As String
    Dim PTMSIDs As Variant
    Dim validID As String
    Dim awb As Workbook
    
    initImportExtractM = False
    
    Set awb = ActiveWorkbook
    
    If PTMS Is Nothing Then
        
        MsgBox (PTMS_MSG12)
        GoTo release
    
    End If
    
    filename = Application.GetOpenFilename(title:="Select a Global PTMS Extract")
    If filename = "False" Or filename = "Falso" Then GoTo release
    
    Set EXTRACTwb = openWorkbook(filename, readOnly:=False, enableMacros:=True, isVisible:=True, returnFocus:=True)
    If EXTRACTwb Is Nothing Then GoTo release
    
    Set EXTRACTws = getWorksheet(EXTRACTwb, "DATA")
    If EXTRACTws Is Nothing Then GoTo release
    
    initGPTMS
    
    Call establishConnectionWithPTMSCentral(awb)
    
    prjTitle = getProjectTitle
        
    If getRow(EXTRACTws.Range("c_ptmstitle"), prjTitle) Is Nothing Then
        MsgBox (GPTMSMSG010): GoTo release
    End If
    
    Erase xRowWithChanges
    Erase DATArWithChanges
    Erase changesType
    Erase newXrows
    Erase deletedDataRows
    
    Set DATAr = Nothing
    Set foundDATAr = Nothing
    
    formCancel = False
    
    Set frm = New manageMLS2Import
    
    
    initImportExtractM = True
release:
    
End Function



'2015-03-25 / B.Agullo /
Public Sub checkChangesInDataSheet()
'description here

    Call standardAutoFilter(EXTRACTws, "PTMStitle", prjTitle)
    
    Set xRows = getVisibleCells(EXTRACTws.Range("c_ptmstitle"))
    If xRows Is Nothing Then GoTo release
    
    Set xRows = xRows.EntireRow
    
    'for each frow in global ptms, check with equivalent in simple PTMS
    'necessary to go by areas, as new milestones will be at the end of data sheet, regardless of project
    For Each xRowsA In xRows.Areas
        For Each xRow In xRowsA.Rows
            Call checkChangesInDataRow
        Next
    Next
    
    '(reverse comparison)
    'check for included milestones which are not present in global ptms (very weird)
    For Each DATAr In DATAws.Range("Datarows").Rows
        If DATAr.Range("Include") = "O" Then
            If Not overlap(DATAr, foundDATAr) Then
                Call addObjectToArrayIfNecessary(deletedDataRows, DATAr)
            End If
        End If
    Next
    
release:
    Set xRows = Nothing
End Sub


'2015-03-25 / B.Agullo /
Public Sub checkChangesInDataRow()
'calls function to evaluate kind of changes, and stores in arrays accordingly
    
    Dim mc As milestoneComparison
    
    Set DATAr = getRow(DATAws.Range("c_item"), xRow.Range("item"))
    
    mc = changesInDATAr
    
    Select Case changesInDATAr
        Case mcNew
            Call addObjectToArrayIfNecessary(newXrows, xRow)
            
        Case mcnewinclude, mcNewunInclude, mcDateChanges
            Call addObjectToArrayIfNecessary(xRowWithChanges, xRow, checkIfPresent:=False)
            Call addObjectToArrayIfNecessary(DATArWithChanges, DATAr, checkIfPresent:=False)
            Call addToArrayIfNecessary(changesType, CStr(mc), checkIfPresent:=False) 'works with strings only
            Set foundDATAr = unify(foundDATAr, DATAr)
            
        Case mcAllOK, mcNA
            Set foundDATAr = unify(foundDATAr, DATAr)
    End Select
    
End Sub


'2015-03-26 / B.Agullo / check milestone dates
'2015-04-21 / B.Agullo / if both relative, don't even show
Public Function changesInDATAr() As milestoneComparison
'returns true if milestone is detected as different

    'if row is not found in PTMS it is a milestone created in global PTMS
    If DATAr Is Nothing Then
        changesInDATAr = mcNew
        GoTo release
    End If
    
    'if both relative, differnces will disapear once formulas arerecalculated
    If DATAr.Range("dateMode") = "Relative" And xRow.Range("dateMode") = "Relative" Then
        changesInDATAr = mcAllOK
        GoTo release
    End If

    With DATAr
        'if milestone is not included in either ptms or global ptms, do not even compare dates
        If .Range("include") <> "O" And xRow.Range("include") <> "O" Then
            changesInDATAr = mcNA
            GoTo release
        End If
        
        'if milestone not included in ptms, but included in global ptms, mark as newInclude
        If .Range("include") <> "O" And xRow.Range("include") = "O" Then
            changesInDATAr = mcnewinclude
            GoTo release
        End If
        
        'if milestone was included in ptms but not included in global ptms, mark as uninclude
        If .Range("include") = "O" And xRow.Range("include") <> "O" Then
            changesInDATAr = mcNewunInclude
            GoTo release
        End If
        
        'if either start or end dates change, mark as dateChages
        changesInDATAr = mcDateChanges
        If .Range("startdate") <> xRow.Range("startdate") Then GoTo release
        If .Range("enddate") <> xRow.Range("enddate") Then GoTo release
        
        'if this point is reached, is included in both schedules without any change
        changesInDATAr = mcAllOK
        
    End With

release:

End Function


'2015-03-26 / B.Agullo /
Public Function showMilestoneChanges() As Boolean
'description here
        
    'Dim frm As manageMLS2Import
    Dim resolution As New API_Resolution
    
    showMilestoneChanges = False
    
    itemCount = 0
    
    frm.top = (resolution.getScreenHeightInPoints - frm.height) / 2
    frm.left = (resolution.getScreenWidthInPoints - frm.width) / 2
  
    Call loadModifiedMilestonesToUserform
    Call loadNewMilestonestoUserform
    Call loadDeletedMilestonestoUserform
    
    showMilestoneChanges = True
    
    frm.show
    
    If formCancel Then
        showMilestoneChanges = False
        GoTo release
    End If
    
    
release:

    Set resolution = Nothing
   
End Function





'2015-03-26 / B.Agullo /
Public Sub loadModifiedMilestonesToUserform()
'show all milestones in which differences have been deteced
    
    Dim i As Integer
    Dim mc As milestoneComparison
    
    If Not arrayHasDimension(xRowWithChanges) Then GoTo release
    
    For i = LBound(xRowWithChanges) To UBound(xRowWithChanges)
        Set xRow = xRowWithChanges(i)
        Set DATAr = DATArWithChanges(i)
        mc = CInt(changesType(i))
        
        With frm.milestonesLB
            .AddItem (DATAr.Range("item").value)
            .List(itemCount, 1) = DATAr.Range("processedDisplayName")
            
            Select Case mc
                Case mcNewunInclude, mcDateChanges
                    .List(itemCount, 2) = printDateString(DATAr.Range("startDate"))
                    .List(itemCount, 3) = printDateString(DATAr.Range("enddate"))
            End Select
            
            Select Case mc
                Case mcDateChanges
                    .List(itemCount, 4) = "------->"
                    .List(itemCount, 7) = "CHANGES"
                
                Case mcnewinclude
                    .List(itemCount, 4) = "INCLUDE"
                    .List(itemCount, 7) = "CHANGES"
                    
                Case mcNewunInclude
                    .List(itemCount, 4) = "REMOVE"
                    .List(itemCount, 7) = "CHANGES"
                    
            End Select
            
            Select Case mc
                Case mcDateChanges, mcnewinclude
                    .List(itemCount, 5) = printDateString(xRow.Range("startDate"))
                    .List(itemCount, 6) = printDateString(xRow.Range("enddate"))
            End Select
            
            .List(itemCount, 8) = i
            itemCount = itemCount + 1
            
        End With
    Next
    
    
       
release:
 
End Sub


'2015-03-26 / B.Agullo /
Public Sub loadNewMilestonestoUserform()
'show milestons that where created in global PTMS

   Dim i As Integer
    
    If Not arrayHasDimension(newXrows) Then GoTo release
    
    For i = LBound(newXrows) To UBound(newXrows)
        Set xRow = newXrows(i)

        
        With frm.milestonesLB
            .AddItem (xRow.Range("item").value)
            .List(itemCount, 1) = xRow.Range("processedDisplayName")
            '.List(itemCount, 2) = printDateString(DATAr.Range("startDate"))
            '.List(itemCount, 3) = printDateString(DATAr.Range("enddate"))
            .List(itemCount, 4) = "--NEW--"
            .List(itemCount, 5) = printDateString(xRow.Range("startDate"))
            .List(itemCount, 6) = printDateString(xRow.Range("enddate"))
            .List(itemCount, 7) = "NEW"
            .List(itemCount, 8) = i
            itemCount = itemCount + 1
        End With
    Next
    
    
       
release:
  
    
End Sub



'2015-03-26 / B.Agullo /
Public Sub loadDeletedMilestonestoUserform()
'show milestones that where deleted in global ptms
   
    Dim i As Integer
    
    If Not arrayHasDimension(deletedDataRows) Then GoTo release
    
    For i = LBound(deletedDataRows) To UBound(deletedDataRows)
        Set DATAr = deletedDataRows(i)

        With frm.milestonesLB
            .AddItem (DATAr.Range("item").value)
            .List(itemCount, 1) = DATAr.Range("processedDisplayName")
            .List(itemCount, 2) = printDateString(DATAr.Range("startDate"))
            .List(itemCount, 3) = printDateString(DATAr.Range("enddate"))
            .List(itemCount, 4) = "--DELETED--"
            '.List(itemCount, 5) = printDateString(xRow.Range("startDate"))
            '.List(itemCount, 6) = printDateString(xRow.Range("enddate"))
            .List(itemCount, 7) = "DELETE MILESTONE"
            .List(itemCount, 8) = i
            itemCount = itemCount + 1
        End With
    Next
    
       
release:
 
End Sub

'2015-03-26 / B.Agullo /
'2015-03-30 / B.Agullo / fine tuning
Public Sub processAcceptedMilestoneChanges()
'actual actions after used has selected update

    With frm.milestonesLB
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                
                Select Case .List(i, 7)
                    
                    Case "CHANGES"
                        Call updateMilestone
                    
                    Case "NEW"
                        Call addMilestone
                    
                    Case "DELETE MILESTONE"
                        Call deleteMilestone
                
                End Select
            End If
        Next
    End With
End Sub



'2015-03-27 / B.Agullo /
'2015-04-21 / B.Agullo / refresh render and move childs
Public Sub updateMilestone()
'updates fields in simple ptms from global extract milestone
 
    Dim arrayP As Integer
    Dim rnA As Variant
    Dim rn As Variant
    Dim DATAc As Range
    
    Dim MLS As Milestone
    
    arrayP = frm.milestonesLB.List(i, 8)
    
    Set DATAr = DATArWithChanges(arrayP)
    Set xRow = xRowWithChanges(arrayP)
    
    'fields to update
    For Each DATAc In DATAws.Range("Datacolumns").Columns
        rn = GetColumnRangeName(DATAc)
        If rangeNameExists(EXTRACTws, rn) Then
            DATAr.Range(rn) = xRow.Range(rn)
        End If
    Next
    
'    Set MLS = getMLS(DATAr.Range("item").value)
'
'    If Not MLS Is Nothing Then
'
'        MLS.refreshRender
'        MLS.moveChilds
'
'    End If
    
    'Call simpleSetFormulasInRow(DATAr)
    
End Sub


'2015-03-27 / B.Agullo /
Public Sub addMilestone()
'add row with all the availabe information from global extract
    
    Dim rn As String
    Dim DATAc As Range
    Dim arrayP As Integer
    
    arrayP = frm.milestonesLB.List(i, 8)
    Set xRow = newXrows(arrayP)
    
    Set DATAr = DATAws.Range("firstEmptyRow")
    
    For Each DATAc In DATAws.Range("Datacolumns").Columns
        rn = GetColumnRangeName(DATAc)
        If rangeNameExists(EXTRACTws, rn) Then
            DATAr.Range(rn) = xRow.Range(rn)
        End If
    Next
    
    Call simpleSetFormulasInRow(DATAr)
    
    
    
End Sub


'2015-03-27 / B.Agullo /
Public Sub deleteMilestone()
'removes rows that were physically deleted from global PTMS -- quite weird

    Dim arrayP As Integer

    arrayP = frm.milestonesLB.List(i, 8)
    
    Set DATAr = deletedDataRows(arrayP)
    
    DATAr.Delete xlShiftUp
    
End Sub

any clue on the steps I should follow to track it down?

thanks!!

Hi Sixthsense,

I do have a couple of UDF, but they are used just to recalculate a number of cells and then are converted to values, so I asume the problem is not there... am I right?

Kyle123, I really don't know where the problem is, and posting the whole workbook seems a bit excessive. Also, it tends to work fine on the first run, and then the problem appears and will not go away. It even pops-up if I input easy operations on the immediate window such as ?3+4

any clue on the steps I should follow to track it down?

thanks!!

You likely have a long running loop or are holding data in public variables that are increased with each run. Depending on the complexity of your code you may have circular references that can't be garbage collected.

Without seeing any of your code, it's completely impossible for us to help any further as there are many things that may cause this, a lot of them are easy to spot with the right experience.

Your code is hard to follow due to the large reliance on Module level variables rather than parameters and the number of helper functions that obscure what's going on, what's the code for:

addObjectToArrayIfNecessary

and

addToArrayIfNecessary

apologies for the code complexity
that's why I was hoping for some general guidelines to apply to my particular case
anyway, here's the code

'2015-03-25 / B.Agullo /
Public Sub addObjectToArrayIfNecessary(ByRef a As Variant, ByVal aItem As Object, Optional ByVal checkIfPresent As Boolean = True, Optional ByVal firstIndex As Integer = 1)
'description here
    
    On Error GoTo firstelement
    
    If checkIfPresent Then
        If isObjectInArray(a, aItem) Then GoTo release
    End If
    
    ReDim Preserve a(LBound(a) To UBound(a) + 1)
    Set a(UBound(a)) = aItem
    
    GoTo release
    
firstelement:
    ReDim a(firstIndex To firstIndex)
    Set a(firstIndex) = aItem
    
release:
  
End Sub

'2015-03-25 / B.Agullo /
Public Function isObjectInArray(ByRef a As Variant, ByVal aNewItem As Object) As Boolean
'description here
    
    Dim aItem As Variant
    
    isObjectInArray = True
    
    For Each aItem In a
        
        If aNewItem Is aItem Then GoTo release
        
    Next

    isObjectInArray = False
    
release:
    
    
End Function

'2013-11-04 / B.Agullo / ported from globalfunctions
'2013-11-11 / B.Agullo / fixed code
'2013-12-03 / B.Agullo / fixed variant parameter for greater compatibility
Public Function isInArray(ByRef a As Variant, ByVal aItem As String) As Boolean
'DEPRECATED -- USE INDEXINLIST = -1 INSTEAD!

    Dim found As Boolean
    Dim i As Integer
    
    found = False

    On Error GoTo exitfunction

    For i = LBound(a) To UBound(a)
        If a(i) = aItem Then found = True: Exit For
    Next
    
exitfunction:
    isInArray = found
    
End Function

'2013-11-04 / B.Agullo / ported from globalfunctions
'2013-11-11 / B.Agullo / fixed type
'2013-12-03 / B.Agullo / fixed variant parameter for greater compatibility
'2014-02-03 / B.Agullo / fixed error
'2015-03-16 / B.Agullo / possible to customize first index
'2015-03-18 / A.Salvá / posibility to skip blanks and trim array strings
'2015-03-19 / B.Agullo / code arrangement
Public Sub addToArrayIfNecessary(ByRef a As Variant, ByVal aItem As String, Optional ByVal checkIfPresent As Boolean = True, Optional ByVal firstIndex As Integer = 1, _
                                 Optional ByVal TrimValues As Boolean = False, Optional ByVal SkipBlanks As Boolean = False)
'adds item to arrya if necessary, even works for firt tiem
    
    On Error GoTo firstelement
    
    If checkIfPresent Then
        If Not indexInList(a, aItem) = -1 Then GoTo release
    End If
    
    If SkipBlanks Then
        If Trim(aItem & "") = "" Then GoTo release
        If LCase(Trim(aItem & "")) = "(blank)" Then GoTo release
    End If

    If TrimValues Then
        aItem = Trim(aItem)
    End If
    
    ReDim Preserve a(LBound(a) To UBound(a) + 1)
    a(UBound(a)) = aItem
    
    GoTo release

firstelement:
    ReDim a(firstIndex To firstIndex)
    a(firstIndex) = aItem
    
release:

End Sub

'2013-12-03 / B.Agullo / fixed variant parameter for greater compatibility
'2013-12-03 / B.Agullo / fixed initialization
'2014-02-03 / B.Agullo / fixed ucase in both sides
'2015-03-11 / B.Agullo / check array dimension
Public Function indexInList(ByRef myList As Variant, ByVal myItem As String) As Integer
'returns position of item in mylist, -1 if not found
    
    Dim i As Integer
    
    indexInList = -1
    If Not arrayHasDimension(myList) Then GoTo release
    
    For i = LBound(myList) To UBound(myList)
        If UCase(myList(i)) = UCase(myItem) Then indexInList = i: GoTo release
    Next
    
release:
    
    
End Function

by the way, the error only shows if VBE is open -- does this ring a bell, or is the default behaviour?

thanks!

Hmm, what I would do is set a lot of break points, step through the code til you get the error. Your style of coding makes is quite difficult to do some of the easier things to try and test, I think you'd have made have made life easier for yourself by:

• Using fewer Public Variables, passing variables as paramaters results in fewer bugs and allows smaller subroutines to be tested as standalone units
• Error handling is not control flow, it's a catch for errors, using it as flow often creates code that's difficult to follow and can have unexpected behaviour
• Using functions where you've used subs would have allowed for a more consistent approach

Does the error message highlight anything, is there a debug button?

Thanks Kyle123

can you clarify a bit more about the use of functions over subs?

then thing is that the error message does not highlight anything -- just "out of memory" and the possibility to click ok.

Have you tried setting breakpoints and stepping through?

Hmm, the point about functions is more personal preference as I think passing by Ref on the whole makes things difficult to follow as it's not easy to see what's going on.

Consider:

Call addObjectToArrayIfNecessary(xRowWithChanges, xRow, checkIfPresent:=False)

Without digging through code, it's not at all easy to see what's being changed, contrast that with:

temp = addObjectToArrayIfNecessary(xRowWithChanges, xRow, checkIfPresent:=False)
xRowWithChanges = temp

Nothing is edited in the function, rather a new array is returned - it makes the code much easier to follow.

FWIW you could make your code a hell of a lot more efficient by using a collection/dictionary. All this, would be a simple single function:

'2015-03-25 / B.Agullo /
Public Sub addObjectToArrayIfNecessary(ByRef a As Variant, ByVal aItem As Object, Optional ByVal checkIfPresent As Boolean = True, Optional ByVal firstIndex As Integer = 1)
'description here
    
    On Error GoTo firstelement
    
    If checkIfPresent Then
        If isObjectInArray(a, aItem) Then GoTo release
    End If
    
    ReDim Preserve a(LBound(a) To UBound(a) + 1)
    Set a(UBound(a)) = aItem
    
    GoTo release
    
firstelement:
    ReDim a(firstIndex To firstIndex)
    Set a(firstIndex) = aItem
    
release:
  
End Sub

'2015-03-25 / B.Agullo /
Public Function isObjectInArray(ByRef a As Variant, ByVal aNewItem As Object) As Boolean
'description here
    
    Dim aItem As Variant
    
    isObjectInArray = True
    
    For Each aItem In a
        
        If aNewItem Is aItem Then GoTo release
        
    Next

    isObjectInArray = False
    
release:
    
    
End Function

'2013-11-04 / B.Agullo / ported from globalfunctions
'2013-11-11 / B.Agullo / fixed code
'2013-12-03 / B.Agullo / fixed variant parameter for greater compatibility
Public Function isInArray(ByRef a As Variant, ByVal aItem As String) As Boolean
'DEPRECATED -- USE INDEXINLIST = -1 INSTEAD!

    Dim found As Boolean
    Dim i As Integer
    
    found = False

    On Error GoTo exitfunction

    For i = LBound(a) To UBound(a)
        If a(i) = aItem Then found = True: Exit For
    Next
    
exitfunction:
    isInArray = found
    
End Function

'2013-11-04 / B.Agullo / ported from globalfunctions
'2013-11-11 / B.Agullo / fixed type
'2013-12-03 / B.Agullo / fixed variant parameter for greater compatibility
'2014-02-03 / B.Agullo / fixed error
'2015-03-16 / B.Agullo / possible to customize first index
'2015-03-18 / A.Salvá / posibility to skip blanks and trim array strings
'2015-03-19 / B.Agullo / code arrangement
Public Sub addToArrayIfNecessary(ByRef a As Variant, ByVal aItem As String, Optional ByVal checkIfPresent As Boolean = True, Optional ByVal firstIndex As Integer = 1, _
                                 Optional ByVal TrimValues As Boolean = False, Optional ByVal SkipBlanks As Boolean = False)
'adds item to arrya if necessary, even works for firt tiem
    
    On Error GoTo firstelement
    
    If checkIfPresent Then
        If Not indexInList(a, aItem) = -1 Then GoTo release
    End If
    
    If SkipBlanks Then
        If Trim(aItem & "") = "" Then GoTo release
        If LCase(Trim(aItem & "")) = "(blank)" Then GoTo release
    End If

    If TrimValues Then
        aItem = Trim(aItem)
    End If
    
    ReDim Preserve a(LBound(a) To UBound(a) + 1)
    a(UBound(a)) = aItem
    
    GoTo release

firstelement:
    ReDim a(firstIndex To firstIndex)
    a(firstIndex) = aItem
    
release:

End Sub

'2013-12-03 / B.Agullo / fixed variant parameter for greater compatibility
'2013-12-03 / B.Agullo / fixed initialization
'2014-02-03 / B.Agullo / fixed ucase in both sides
'2015-03-11 / B.Agullo / check array dimension
Public Function indexInList(ByRef myList As Variant, ByVal myItem As String) As Integer
'returns position of item in mylist, -1 if not found
    
    Dim i As Integer
    
    indexInList = -1
    If Not arrayHasDimension(myList) Then GoTo release
    
    For i = LBound(myList) To UBound(myList)
        If UCase(myList(i)) = UCase(myItem) Then indexInList = i: GoTo release
    Next
    
release:
    
    
End Function

the error today seems to have vanished --
I added sentences to set variables to nothing and erase arrays
also, the source workbook is now open in a macro-disabled instance of excel, so there are less things potentially causing the problem.

with arrays I had some trouble in the past and finally settled for this approach which at least didn't cause errors.

in any case -- I'll keep in mind your comments and apply them wherever possible.

thanks for your time!

No problem at all, erasing arrays and setting variables to nothing is normally a waste of time since they get released when they go out of scope anyway


Sent from my iPhone using Tapatalk