There is Not Enough Memory To Complete this Action

Question

I've written the below code to modify a speadsheet that has tens of thousands of lines. Whenever I run the code, it burns through the lines fast enough, will complete about 10k lines in 3-4 minutes or so. But every time I run it, it gets to about line 25K or so, and crashes, telling me I don't have enough memory, and will suggest upgrading to 64-bit. I have a macro that created the sheet without incident, and it's much more complex, so seems odd this code crashes it. Anything in this code that you'd think would cause my issue? Or is 64-bit likely the right fix?

    Sub TPOUploadCADUplicate()
'This takes the TPO Mass upload sheet and duplicates it below for Canada. Unlike above, it doesn't do anything to the US part on top
Dim Answer As String
Dim BigMarkup As Double
Dim CAPrice As Double
Dim Cost As Double
Dim i As Long
Dim rn As Long
Dim rn2 As Long
Dim SKUCount As Double
Dim STMarkup As Double
Dim USPrice As Double
Dim lr As Long
Dim DescLen As Integer

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

'Make sure you didn't accidentally leave the description length column in
If Cells(1, 3) <> "VENDOR # (9 SPACES)" Then
    DescLen = MsgBox("Yo, bro. I think you left the description length column in. You want to delete that shit? I can't proceed otherwise.", vbYesNo)
    If DescLen = 6 Then
        Columns(3).Delete
    ElseIf DescLen = 7 Then
        Exit Sub
    End If
End If

Columns(6).NumberFormat = "#.00"
'Loop through each one, doing the math from the TPO price calculator Connie has
If Cells(2, 1) = "" Then Exit Sub
rn = Cells(1, 1).End(xlDown).Row

rn2 = rn + 1
rn = 2
SKUCount = rn2 - rn
For i = 1 To SKUCount
    Application.StatusBar = "Progress: " & i & " of " & SKUCount & " - " & Format(i / SKUCount, "0%")
    Rows(rn2).Value = Rows(rn).Value
    USPrice = Cells(rn, 4)
    If USPrice * CAMarkup < 20 Then
        CAPrice = Round((USPrice) * CAMarkup, 1) + 0.09
    Else
        CAPrice = WorksheetFunction.RoundDown((USPrice) * CAMarkup, 0) + 0.99
    End If

    Cells(rn2, 4) = CAPrice
    Cells(rn2, 6).Value = Cells(rn2, 6).Value * CAMarkup
    Cells(rn2, 22) = "CAM"
    rn = rn + 1
    rn2 = rn2 + 1

Next i

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = False
End With

End Sub

Answer 1

Might be better (faster) to read all the data to an array, then work on the array, before putting it on the sheet after the existing data.

Sub TPOUploadCADUplicate()
    
    Dim ans
    Dim CAPrice As Double
    Dim SKUCount As Double
    Dim STMarkup As Double, CAMarkup As Double
    Dim USPrice As Double
    Dim DescLen As Integer, ws As Worksheet, arr, lr As Long, lc As Long, r As Long
    
    Set ws = ActiveSheet 'best to be explicit about which sheet you're working with
    
    'Make sure you didn't accidentally leave the description length column in
    If ws.Cells(1, 3) <> "VENDOR # (9 SPACES)" Then
        ans = MsgBox("Yo, bro. I think you left the description length column in. " & _
                "You want to delete that shit? I can't proceed otherwise.", vbYesNo)
        If ans <> vbYes Then Exit Sub
        ws.Columns(3).Delete
    End If

    ws.Columns(6).NumberFormat = "#.00"
    
    lr = ws.Cells(Rows.Count, "A").End(xlUp).Row         'last row
    If lr = 1 Then Exit Sub 'no data?
    lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column 'last column
    
    CAMarkup = 1.1 '<< for example
    arr = ws.Range("A2", ws.Cells(lr, lc)).value 'copy the existing data as an array
    
    For r = 1 To UBound(arr, 1) 'loop over the array and make adjustments
        USPrice = arr(r, 4)
        If USPrice * CAMarkup < 20 Then
            CAPrice = Round((USPrice) * CAMarkup, 1) + 0.09
        Else
            CAPrice = WorksheetFunction.RoundDown((USPrice) * CAMarkup, 0) + 0.99
        End If
    
        arr(r, 4) = CAPrice
        arr(r, 6) = arr(r, 6) * CAMarkup
        arr(r, 22) = "CAM"
    Next r
    
    'put the data on the sheet
    ws.Cells(lr + 1, "A").Resize(UBound(arr, 1), UBound(arr, 2)).value = arr

End Sub