Error Message 'Excel cannot complete this task with available resources. Choose less data or close other applications"

[e3ucjr]

Hi All,

This is my first post ever so my thread may not follow normal protocol. Please instruct if I have forgotten something.

Anyways, I have written a code that essentially moves data from one sheet to another sheet and performs a variety of manipulations. The workbook is rather large and includes 7 modules. I built the book out module by module, and only moved on to the next module when the previous module ran correctly with out errors(Hence, this code worked at one point). I have finally completed the workbook, however one of my modules is returning the above error. Once I click ok, I get a follow up error "Run-time error '1004' Insert Method of Range Class Failed"

Below is the code...the error occurs where I have highlighted red:
Sub Copy_Mod_Data()
'Use Input Request - Specify Loan Group
Dim userentry As Variant
userentry = InputBox("Enter the number for the data you would like to import(Select only one):" & vbNewLine & "1 = Defensive Refi" & vbNewLine & "2 = Modifications" & vbNewLine & "3 = Forbearance")
If userentry = "" Then Exit Sub
If userentry <> "" Then Range("h1").Value = userentry
'User Input Request - If Yes, it will not add new columns a second time
Dim userentry1 As Variant
userentry1 = InputBox("Have you already run the COPY TO HISTORICAL macro for any other categories this quarter:" & vbNewLine & "1 = No" & vbNewLine & "2 = Yes")
If userentry1 = "" Then Exit Sub
If userentry1 <> "" Then Range("h2").Value = userentry
'Set Values Based on user Input
If userentry = 1 Then
numfiles = Range("cellcount_1").Value
startrow = [row_start_def].Value
His_cell_start = [start_cell1].Value
ElseIf userentry = 2 Then
numfiles = Range("cellcount_2").Value
startrow = [row_start_mod].Value
His_cell_start = [start_cell2].Value
ElseIf userentry = 3 Then
numfiles = Range("cellcount_3").Value
startrow = [row_start_forb].Value
His_cell_start = [start_cell3].Value
End If
'Define variables
Dim lastrow As Long
Dim rSource As Excel.Range
Dim rDestination As Excel.Range
Dim newrange As Excel.CellFormat
sheet_source = [Destination_Sheet1].Value
sheet_des = [Destination_Sheet4].Value
'Set Values
modcount = numfiles - 1
lastrow = startrow + modcount
Set rSource = Sheets(sheet_source).Range("A" & startrow & ":Q" & lastrow)
Set rsource1 = Sheets(sheet_source).Range("V" & startrow & ":V" & lastrow)
Set rsource2 = Sheets(sheet_source).Range("X" & startrow & ":AK" & lastrow)
Set rsource3 = Sheets(sheet_source).Range("AL" & startrow & ":AP" & lastrow)
Set rDestination = Sheets(sheet_des).Range(His_cell_start).End(xlDown).Offset(1, 0)
'Insert Blank Rows At the bottom of historical data
Sheets(sheet_des).Rows(rDestination.Row & ":" & rDestination.Row + modcount).Insert
'Insert 2 new Columns for new Quarterly Allowance and SDQ Data
If userentry1 = 1 Then
colu = [columncount].Value - 1
Sheets("Historical").Range("A1").Offset(0, colu).Resize(, 2).EntireColumn.Insert
End If
'Specify Range Identifiers and Column Titles
new_Column1 = [columncount].Value - 2
new_Column2 = [columncount].Value - 1
rowvalue = rDestination.Row
'Specify New Destination Range
If userentry = 1 Then
Sheets("Historical").Cells(2, 19) = rowvalue - 1
Sheets("Historical").Cells(1, 19) = rowvalue - numfiles
new_row = [rangetop1].Value
ElseIf userentry = 2 Then
Sheets("Historical").Cells(2, 17) = rowvalue - 1
Sheets("Historical").Cells(1, 17) = rowvalue - numfiles
new_row = [rangetop].Value
ElseIf userentry = 3 Then
Sheets("Historical").Cells(2, 21) = rowvalue - 1
Sheets("Historical").Cells(1, 21) = rowvalue - numfiles
new_row = [rangetop2].Value
End If
'Change Column Titles
Sheets("Historical").Cells(7, new_Column1) = [Quarter_Date].Value & " Allowance"
Sheets("Historical").Cells(7, new_Column2) = [Quarter_Date].Value & " SDQ Amount"
'Copy source Data
rSource.Copy
'Pastevalues_Initial Block before new column
Sheets(sheet_des).Range(His_cell_start).End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=False, _
Transpose:=False
'Copy and PasteValues - First after new Column
rsource1.Copy
new_column = [columncount].Value + 1
Sheets(sheet_des).Cells(new_row, new_column).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=False, _
Transpose:=False
'Copy and PasteValues - Second after new Column
rsource2.Copy
new_column = [columncount].Value + 2
Sheets(sheet_des).Cells(new_row, new_column).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=False, _
Transpose:=False
'Copy and PasteValues - Third after new column
rsource3.Copy
new_column = [columncount].Value + 17
Sheets(sheet_des).Cells(new_row, new_column).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=False, _
Transpose:=False

'Set Date in Column B
For Counter = 0 To modcount
Qdate = [Quarter_Date].Value
Sheets(sheet_des).Cells(new_row + Counter, 2) = Qdate
Next Counter
'Move back to top left corner of sheet
Range("A1").Select

Application.CutCopyMode = False

'Output message to user
MsgBox "Data Import Complete!"

'Output Time Stamp
Worksheets("Inputs").Activate
ActiveSheet.Range("B18") = Now
End Sub


PLEASE HELP! Thanks in advance

 

[e3ucjr]

So, essentially after more tinkering around with the workbook, I have concluded the code is not the issue. The shear amount of processing required in the form of data tables that are linked to this source data is actually to much for excel to handle. I concluded this after attempting to insert several rows mid data and recieving an error message "Large Operation-The operation you are about to perform affects a large number of cells and may take a significant amount of time to complete."

Does anyone have any suggestions for this?