Creating an ArrayList in VBA Throws Out Of Memory Error
A 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.


The 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
Loop
nCurrent = 1
Do While Sheets(strTabName).Range(FindExcelCell(nCurrent, 1)).Value <> ""
nColumns = nCurrent
nCurrent = nCurrent + 1
Loop
ActiveWorkbook.Worksheets(strTabName).Sort.SortFields.Clear
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
.Apply
End With
End FunctionIn 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
Next
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.
Next
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.
'https://wellsr.com/vba/2018/excel/vba-quicksort-macro-to-sort-arrays-fast/
'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
Wend
While (pivotVal < vArray(tmpHi) And tmpHi > arrLbound)
tmpHi = tmpHi - 1
Wend
If (tmpLow <= tmpHi) Then
vSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = vSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
If (arrLbound < tmpHi) Then Quicksort vArray, arrLbound, tmpHi 'conquer
If (tmpLow < arrUbound) Then Quicksort vArray, tmpLow, arrUbound 'conquer
RetVal = DoEvents
End Sub

