Excel 2003 memory issue ?!? arghh!

samilynn

Board Regular
Joined
Jun 24, 2003
Messages
141
I get the following message when I try to run the VB code listed below, which used to work flawlessly with Excel 200.
"Excel cannot complete this task with available resources. Choose less data or close other applications.".
The workbooks aren't that large, but they do contain graphics.
Can you help?
Thanks.

(the code is:


Option Explicit

Dim rngData As Range

Sub ReadWorkbooks()

Const strDirectory As String = "C:\Documents and Settings\MarcD\Desktop\mg"
Dim varFile As Variant

Set rngData = ThisWorkbook.Worksheets("Data").Range("A" & _
ThisWorkbook.Worksheets("Data").Range("A65536").End(xlUp).Row).Offset(1, 0)

Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = strDirectory
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For Each varFile In .FoundFiles
Merge varFile
Next
End If
End With
Application.ScreenUpdating = True

End Sub

Sub Merge(ByVal strFileName As String)

Dim lngEndRow As Long, lngRow As Long
Dim ws As Worksheet, shp As Shape

Workbooks.Open strFileName

For Each ws In ActiveWorkbook.Worksheets

ws.Rows(1).Insert
ws.Columns("M").Insert

lngEndRow = ws.Range("A65536").End(xlUp).Row
ws.Range("M2:M" & lngEndRow).FormulaR1C1 = "=CountA(RC1:RC[-1])"
ws.Range("A1:M" & lngEndRow).AutoFilter Field:=13, Criteria1:="<>0"

ws.Range("A2:L" & lngEndRow).SpecialCells(xlCellTypeVisible).Copy
rngData.PasteSpecial xlPasteValues

For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp

Set rngData = ThisWorkbook.Worksheets("Data").Range("A" & _
ThisWorkbook.Worksheets("Data").Range("A65536").End(xlUp).Row).Offset(1, 0)
Next ws
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True

End Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Forum statistics

Threads
1,141,019
Messages
5,703,776
Members
421,315
Latest member
awaisnazir139

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top