Creating an ArrayList in VBA Throws Out Of Memory Error

Jimbo's picture

Out of memoryA snippet of code that worked fine for years suddenly stopped working on a new laptop and began throwing "Out of memory" errors and then "Automation error" messages. The new computer has quadruple the memory that the old computer had, so that couldn't be the problem.

Ultimately, the final conclusion was that the library containing "System.Collections.ArrayList" was corrupt and throwing the incorrect error. After some experimenting with other mscorlib.dll libraries, the requirement to work around the issue was obvious.

Excel memoryThe ArrayList object was used to stack strings and then sort them. Material Master numbers concatenated with four-character Plant IDs comprised the data, so two options were available.

In Excel, any data that are fewer than 1048576 rows (including the header row) can easily and quickly be sorted in the Worksheet using this simple code. It assumes that there are no blank values in the A column and that there is a header over every column in the first row.

Data like this can be extracted easily enough from SAP into Excel by calling RFCs from VBA. Un-remark the code for the C column to easily make this the "SortByFirstThreeColumns" function or customize the code to sort all the columns by any combination of columns.

dim isSorted as Boolean
isSorted = SortByFirstTwoColumns("MARC")

Function SortByFirstTwoColumns(strTabName As String) As Boolean
    Dim nRows As Long, nColumns As Long, nCurrent As Long
    Sheets(strTabName).Activate  'Make the tab to be sorted the "ActiveWorkbook".
    nCurrent = 1
    Do While Sheets(strTabName).Range("A" & nCurrent).Value <> ""
        nRows = nCurrent - 1
        nCurrent = nCurrent + 1
    nCurrent = 1
    Do While Sheets(strTabName).Range(FindExcelCell(nCurrent, 1)).Value <> ""
        nColumns = nCurrent
        nCurrent = nCurrent + 1
    ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Add Key:=Range("A2:A" & (1 + nRows)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Add Key:=Range("B2:B" & (1 + nRows)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    'ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Add Key:=Range("C2:C" & (1 + nRows)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(strTabName).Sort
        '.SetRange Range("A2:Z" & (1 + nRows))
        .SetRange Range("A2:" & FindExcelCell(nColumns, 1 + nRows))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
    End With
End Function

In case the array is more than a million records that cannot fit in a Worksheet, there is another solution. A simple Variant array can be populated with each record and then sorted with some recycled code from this talented programmer's page.

A nested loop that slowly steps through each record to every other record in the array and swapping when necessary might lead to trillions of comparisons and hours or days of runtime. This clever code calls itself recursively to make quick work of large sorting requirements and works just fine with numbers or strings.

sub ExampleSub(nCountMARC as long)
    Dim arr() As Variant, nCurrent as long, strTemp as string
    For nCurrent = 1 To nCountMARC
        strTemp = "" 'Use your code to populate strTemp with the data that comprises your data. 
        ReDim Preserve arr(nCurrent - 1)
        arr(nCurrent - 1) = strTemp
    Call Quicksort(arr, LBound(arr), UBound(arr))

    'The data are sorted, so stepping through the values in order is easy now.
    For Each strTemp in arr
        'Put the code to handle the ordered values here.
End Sub

Sub Quicksort(vArray As Variant, arrLbound As Long, arrUbound As Long)
    'Very special thanks to this site for this brilliant snippet of code.
    'Sorts a one-dimensional VBA array from smallest to largest
    'using a very fast quicksort algorithm variant.
    Dim pivotVal As Variant
    Dim vSwap    As Variant
    Dim tmpLow   As Long
    Dim tmpHi    As Long
    tmpLow = arrLbound
    tmpHi = arrUbound
    pivotVal = vArray((arrLbound + arrUbound) \ 2)
    While (tmpLow <= tmpHi) 'divide
       While (vArray(tmpLow) < pivotVal And tmpLow < arrUbound)
          tmpLow = tmpLow + 1
       While (pivotVal < vArray(tmpHi) And tmpHi > arrLbound)
          tmpHi = tmpHi - 1
       If (tmpLow <= tmpHi) Then
          vSwap = vArray(tmpLow)
          vArray(tmpLow) = vArray(tmpHi)
          vArray(tmpHi) = vSwap
          tmpLow = tmpLow + 1
          tmpHi = tmpHi - 1
       End If
  If (arrLbound < tmpHi) Then Quicksort vArray, arrLbound, tmpHi 'conquer
  If (tmpLow < arrUbound) Then Quicksort vArray, tmpLow, arrUbound 'conquer
  RetVal = DoEvents
End Sub

Excel meme

Programming Language: