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 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 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