Out of memory error copying cells from one sheet to another

Question

There are a lot of questions regarding this issue. I read many of them and tried a few things but they don't fix my case.

I am trying to compare lines from two different (very long) sheets. If specific indices match then specific cells (always the same columns with the current line) need to be copied from one sheet into the other.

It looks like this just bigger (enlarged example):

Dim ArrayOne() as string
Dim ArrayTwo() as string

Redim ArrayOne (1 to AmountOfRowsSheet1)
Redim ArrayTwo (1 to AmountOfRowsSheet2)

For i = 1 to AmountOfRowsSheet1
   ArrayOne(i) = Sheet1.Cells(i, ThisColumn)
next i

For i = 1 to AmountOfRowsSheet2
   ArrayTwo(i) = Sheet2.Cells(i, ThatColumn)
next i

for i = 1 to 4600
    for j = 1 to 69000

        if ArrayOne(i) Like "*" & ArrayTwo(j) then
            Sheet1.Cells(i, 5).value = Sheet3.Cells(i,10).value
            'the line above is repeated about 20 times just with different columns
            'so it gets potentially executed 4600*69000*20 times (6348000000)
        end if
    
    next j
next i

For-loop and everything is working, it also copies correctly but after an amount of lines I run out of memory. In the TaskManager I can see my used RAM tick up every few seconds. At one point Excel displays an error that it can't handle the next copying because of a lack of resources.

I tried:

Application.CutCopyMode = False '( at restart of loop)

Creating an empty data object and putting it into the clipboard.

and a few user32.dll fixes I found.

Answer 1

Not an answer to the question but instead of:

For i = 1 to AmountOfRowsSheet1
   ArrayOne(i) = Sheet1.Cells(i, ThisColumn)
next i

try:

ArrayOne= Range(Cells(1, ThisColumn), Cells(AmountOfRowsSheet1, ThisColumn))

ArrayOne will be a 2D array, with data starting in (1,1) and incrementing (n,1)...

Quicker to get data and similar can be used for putting an array back into a worksheet - also miles quicker than a for loop.

Edit: Again, not direct answer to the question, but this:

import random, string

# ---------------------------------------------------------
#This part is just generating random data to compare against each other (and in case of lists 5 & 6, the data on the sheet in Sheets1(i,5) & Sheets3(i,10)
N1 = 6
list2 = []

list5 = []  #This would correspond to existing vals in Sheets(1.cells(i,5)
list6 = []  #and this to Sheets3.cells(i,10)
for i1 in range(0, 4600):
    list2.append(''.join(random.choice(string.ascii_uppercase + string.digits) for _ in range(N1)))
    list5.append(5)
    list6.append(10)
    
N2 = 12
list3 = []
for i1 in range(0, 69000):
    list3.append(''.join(random.choice(string.ascii_uppercase + string.digits) for _ in range(N2)))




list2[0] = "$$$$$$"  #Just setting two values so we can check the method works
list3[10] = "$$$$££££££"

# ---------------------------------------------------------

#This part is actually doing what your trying to do in VBA 
list4 = []
ij1 = 0
for j1 in list2:
    found = False
    for j2 in list3:
        if j1 in j2:
            found = True
            break
    if found:
        list4.append(list6[j1])
    else:
        list4.append(list5[j1])
            
    ij1 += 1

The bit your interested in runs in around 25 seconds. Absolutely no fancy code-work needed. Go look at downloading anaconda. You'd probably be quicker reading your two excel files into python, do your ops, then writing back out again than trying to do it purely in VBA.

Answer 2

I turned your example into how you would work with arrays

Option Explicit

Sub Example()
    Dim ArrayOne() As Variant
    Dim ArrayTwo() As Variant
    
    ArrayOne = Sheet1.Columns(1).Value 'read column 1 into array
    ArrayTwo = Sheet2.Columns(2).Value 'read column 2 into array
    
    Dim start
    start = Timer
    
    Dim i As Long
    For i = 1 To 4600

        Dim j As Long
        For j = 1 To 69000
            If ArrayOne(i, 1) Like "*" & ArrayTwo(j, 1) Then
                Sheet.Cells(i, 5).Value = Sheet.Cells(i, 10).Value + 1
            End If
        Next j
        
        Debug.Print i, start, Timer, "Runtime=" & Timer-start

        Stop 'we want to test time of one iteration = 23 seconds
    Next i
End Sub

This example run 23 seconds (on my computer) for one iteration of the j loop. So this will run in total 23*4600 seconds which is about 30 hours.

So either you strip down the data that needs to be processed or you use something else than Excel VBA to get it faster. Or you change your entire approach.

Note that VBA is limited to single threading. So no matter how many cores your CPU has VBA will only use one. That makes it actually a pretty bad tool for processing big data.

---

Actually what you need to get rid of is the read/write actions to the cells

Sheet.Cells(i, 5).Value = Sheet.Cells(i, 10).Value

Whenever you access a cell value it slows down a lot. Without that line the loop runs in 2 instead of 23 seconds (still a total runtime of 2.5 hours). So there is potential to get this faster, but probably not much faster than 2.5 hours.

If you cannot get rid of multiple read/write actions then even turning off calculation Application.Calculation = xlCalculationManual before going into the loop brings an immense boost. Just don't forget to turn it on Application.Calculation = xlCalculationAutomatic in the end. Note that turning off calculation only works if you have no formulas that need to be calculated while your loop runs (otherwise you get faulty results).

I recommend to try to improve your real code like above and check the runtime for one full run of the inner j loop as I did with the stop command. This way you can easily calculate the entire runtime by multiplication with 4600.