There is Not Enough Memory To Complete this Action - excel

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