memory issues

G

Guest

I have a macro that opens sequentially 34 quite large spreadsheets and copies
data from up to 10 cells in each and pastes it to one spreadsheet. I am
using the
sourcedata.copy to destinationrange
this is causing terrible memory problems.
Does anyone have any ideas how i get around this. The destination
spreadsheet also has about 400 linked cells to 3 other workbooks.

I also have another issue in that the spreadsheets that are being opened to
copy data from have a macro that is fired on closing the spreadsheet that
produces a message box asking if the user wishes to update. The code on this
spreadsheet is protected how do i avoid having to cancel each message box to
enable the spreadsheet to close.

Any help will be much appreciated

Regards

Spike
 
G

Guest

You don't need to open a workbook to get data from it. Ron Debruin has code
that allows you to obtain data without opening the wb:

http://www.rondebruin.nl/ado.htm

The following is another example of how to get data from closed wbs. Assumed
is that the data from all source wbs is in column A starting at A1. Also
assumed is that you want to copy to the destination wb into column A starting
in cell A1 for the first source wb and then to column B for the second source
wb and so forth. Minimal testing:

Sub TransferData()
Dim c As Range, cc As Range
Dim ws As Worksheet
Dim P As String, FN As String
Dim FileNameArr As Variant
Dim i As Long, ii As Long, Pos As Long

On Error GoTo ExitProc
FileNameArr = Application.GetOpenFilename _
("Excel Files(*.xls), *.xls", MultiSelect:=True)
If VarType(FileNameArr) = vbBoolean Then Exit Sub
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
Set ws = ThisWorkbook.Sheets("Sheet1") 'Destination ws
Set c = ws.Range("A1") 'Top cell in destination range
Pos = InStrRev(FileNameArr(1), "\")
P = Left(FileNameArr(1), Pos - 1) 'Path of first source wb
For i = LBound(FileNameArr) To UBound(FileNameArr)
FN = Dir(FileNameArr(i)) 'Iterate through source wb names
ii = 1
Do
Set cc = c(ii, i)
cc.Formula = "='" & P & "\[" & FN & "]Sheet1'!" & c(ii,
1).Address & ""
cc.Value = cc.Value 'Transform formulas to values
ii = ii + 1
Loop Until cc.Value = 0
cc.ClearContents
Next i
ExitProc:
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Regards,
Greg
 
G

Guest

Spike:

you can disable even and change Calculation property

try,

Dim wbk As Workbook
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set wbk = Workbooks.Open("C:\123.xls")
ThisWorkbook.Sheets("Sheet1").Range("A1:A10").Copy _
wbk.Sheets("Sheet1").Range("A1:A10")
wbk.Close SaveChanges:=True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
 
R

Ron de Bruin

For the OP

Ado is a good option, another option is to create links to the workbooks
http://www.rondebruin.nl/summary2.htm



--
Regards Ron de Bruin
http://www.rondebruin.nl


Greg Wilson said:
You don't need to open a workbook to get data from it. Ron Debruin has code
that allows you to obtain data without opening the wb:

http://www.rondebruin.nl/ado.htm

The following is another example of how to get data from closed wbs. Assumed
is that the data from all source wbs is in column A starting at A1. Also
assumed is that you want to copy to the destination wb into column A starting
in cell A1 for the first source wb and then to column B for the second source
wb and so forth. Minimal testing:

Sub TransferData()
Dim c As Range, cc As Range
Dim ws As Worksheet
Dim P As String, FN As String
Dim FileNameArr As Variant
Dim i As Long, ii As Long, Pos As Long

On Error GoTo ExitProc
FileNameArr = Application.GetOpenFilename _
("Excel Files(*.xls), *.xls", MultiSelect:=True)
If VarType(FileNameArr) = vbBoolean Then Exit Sub
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
Set ws = ThisWorkbook.Sheets("Sheet1") 'Destination ws
Set c = ws.Range("A1") 'Top cell in destination range
Pos = InStrRev(FileNameArr(1), "\")
P = Left(FileNameArr(1), Pos - 1) 'Path of first source wb
For i = LBound(FileNameArr) To UBound(FileNameArr)
FN = Dir(FileNameArr(i)) 'Iterate through source wb names
ii = 1
Do
Set cc = c(ii, i)
cc.Formula = "='" & P & "\[" & FN & "]Sheet1'!" & c(ii,
1).Address & ""
cc.Value = cc.Value 'Transform formulas to values
ii = ii + 1
Loop Until cc.Value = 0
cc.ClearContents
Next i
ExitProc:
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Regards,
Greg

Spike said:
I have a macro that opens sequentially 34 quite large spreadsheets and copies
data from up to 10 cells in each and pastes it to one spreadsheet. I am
using the
sourcedata.copy to destinationrange
this is causing terrible memory problems.
Does anyone have any ideas how i get around this. The destination
spreadsheet also has about 400 linked cells to 3 other workbooks.

I also have another issue in that the spreadsheets that are being opened to
copy data from have a macro that is fired on closing the spreadsheet that
produces a message box asking if the user wishes to update. The code on this
spreadsheet is protected how do i avoid having to cancel each message box to
enable the spreadsheet to close.

Any help will be much appreciated

Regards

Spike
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top