not Enough Resources error

[milton friedman]

Good afternoon.

I am trying to create a more efficent code. After 29800 lines of copy/pasting, it gives me the "not enough sources" error. Below is the code. How do I make it more efficent to stop the error.

Private Const importedSheet As String = "Imported" ' Imported Sheet
Private Const combinedSheet As String = "Combined" 'Combined sheet name
Private importPtr As Long ' Imported file name row pointer
Sub main()
Dim response As Variant ' User response

Call selectXls ' Sub call

End Sub
Private Sub selectXls()
Dim thisWb As Workbook ' Executing workbook object
Dim xlsFiles As Variant ' Multiple .xls path & filename Array
Dim xls As Variant ' Current .xls path & filename
Dim xlsCommonSheet As Integer ' .xls common worksheet name
Dim startRowCopy As Long ' Row to start copying from
Dim pastePtr As Long ' Pointer to start pasting from
Dim totalFiles As Integer
Dim counterFilesOpened As Integer ' number of files the code opens

On Error GoTo genericHandler
' Helps speed up process
Application.EnableCancelKey = False
Application.Calculation = xlCalculationManual
Application.CutCopyMode = False

xlsCommonSheet = Range("Sheet_Name_to_Combine")
startRowCopy = Range("startRow")
Set thisWb = Workbooks(ThisWorkbook.Name)
xlsFiles = Application.GetOpenFilename(, , "Select file(s) for the combine routine", , True)

Application.ScreenUpdating = False

' Check that cancel has not been selected
If IsArray(xlsFiles) Then
Sheets(combinedSheet).Select
pastePtr = startRowCopy

'Reset & Clear Data
importPtr = 0
thisWb.Sheets(importedSheet).Cells.Clear
thisWb.Sheets(combinedSheet).Rows(pastePtr & ":" & Application.Rows.Count).Clear
totalFiles = 0
counterFilesOpened = 0

Call totalFilesArray(totalFiles, xls, thisWb, xlsFiles) 'This counts how many files are in array


For Each xls In xlsFiles
If thisWb.FullName <> xls Then
Call processXls(pastePtr, xls, thisWb, xlsCommonSheet, startRowCopy) 'Sub Call
Call updatePercentage(totalFiles, counterFilesOpen)
End If
Next xls
Unload CombineSpreadSheet
Alert.Show
End If
Exit Sub

genericHandler: ' Error Reporting Facility
thisWb.Activate
Call resetDefault ' sub call
MsgBox "Error Number: " & Err.Number & vbCr & _
"Error Description: " & Err.Description, vbInformation + vbOKOnly, "Combined Error Report"
End Sub
Private Sub processXls(ByRef pastePtr As Long, ByVal xls As Variant, _
ByVal thisWb As Workbook, _
ByVal xlsCommonSheet As Integer, ByVal startRowCopy As Long)
Dim openWb As Workbook ' Open workbook Object
Dim lastRowx As Long ' Hold for last cell row in common worksheet

Workbooks.Open (xls) 'Open workbook
Set openWb = Workbooks(ActiveWorkbook.Name)

With openWb.Sheets(xlsCommonSheet)
.Select
lastRowx = lastRow()
If lastRowx > 0 Then

CombineSpreadSheet.fileName.Caption = openWb.Name 'updates the filename in the dialog box

DoEvents

.Rows(startRowCopy & ":" & lastRow).Copy
thisWb.Sheets(combinedSheet).Range("A" & pastePtr).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
pastePtr = pastePtr + (lastRowx - startRowCopy) + 1

' Add to imported
importPtr = importPtr + 1
thisWb.Sheets(importedSheet).Range("A" & importPtr) = openWb.Name
End If
End With
Workbooks(openWb.Name).Close SaveChanges:=False 'Close workbook
End Sub
Private Function lastRow()
lastRow = 0
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
lastRow = Cells.Find(What:="*", After:=[a1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
End Function
Private Sub totalFilesArray(ByRef totalFiles As Integer, ByVal xls As Variant, ByVal thisWb As Workbook, ByVal xlsFiles As Variant)
totalFiles = 0
For Each xls In xlsFiles
If thisWb.FullName <> xls Then
totalFiles = totalFiles + 1
End If
Next xls
End Sub
Private Sub resetDefault()
' Sub to reset application screen and calculation
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub updatePercentage(ByVal totalFiles As Integer, ByRef counterFilesOpened)

'Code modifies the the percentage complete as well

Dim barWidth As Double
Dim barPercentage As Integer

counterFilesOpened = counterFilesOpened + 1
barWidth = (counterFilesOpened / totalFiles)
barPercentage = barWidth * 100

With CombineSpreadSheet

.statusBar.Width = barWidth * 180
.statusPercentage.Caption = barPercentage & "%"

DoEvents

End With
End Sub

[patel45]

too long to check, attach a sample file for testing

[AB33]

Milton, The Economist,
The reason your code filled up the page because you have wrapped your code with tags. Please use code tags with your code.

[ code]
your code
[code]