Consolidate external data -- proofread #2

[Ray]

Hi All -

I'm like to use the following code to 'consolidate' data from approx
30 external data files into one Master file. The code works perfectly
until it gets to the 16th file, where I get the infamous Run-time
Error 1004. The line where I get the error can be found between the
****** (towards the end of the code).

If I take out the 16th file and re-run the macro, it again stops at
the 16th file (used to be the 17th) -- so, I'm 99% sure that it's not
data file related, but something in my code.

All data files are named identically, with only the 1st three digits
being different. I'm using XL2003 on XP ... any help is greatly
appreciated ...
[I'm sure there's some 'junk' code (ie unused variables) in this --
I've been tinkering for days with it .... ]

Sub FetchStoreData()
Dim MyPath, getstore As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount, x As Long
Dim Fnum, i As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim ws, sh As Worksheet

MyPath = "\\retus100-nt0009\common_b\na-cash\US\DailySales\2007
Daily Sales\"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

' On Error GoTo CleanUp

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
'clear all cells on all sheets
For Each ws In basebook.Worksheets
ws.UsedRange.ClearContents
Next

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), 0)

' Isolates the store number from the workbook name
getstore = Left(mybook.Name, 3)

Set sourceRange = mybook.Sheets("Store
SRA").Range("F:AF").EntireColumn

Set destrange = basebook.Sheets(getstore).Range("A1")

With sourceRange
Set destrange =
basebook.Sheets(getstore).Range("A1").Resize(.Rows.Count, .Columns.Count)
End With
'****** destrange.Value = sourceRange.Value
'******
mybook.Close savechanges:=False
Next
End If

Call ConsData 'consolidates data from store tabs to USA tab

CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

[Joel]

I suspect you are exceeding some limits in excel. I think your copying may
be using the clipboard without you realizing this. when the failure coours
go to worksheet and open on view Menu - Task Pane. The down arrow (next to
X) select clipboard. see if there are a lot of items in clipboard.

One possible fix is follows:

from:
destrange.Value = sourceRange.Value
to:
sourcerange.copy destination:=destrange


Let me know it this works. I believe when copying between worksheets
sometimes excel uses the clipboard.

Hi All -

I'm like to use the following code to 'consolidate' data from approx
30 external data files into one Master file. The code works perfectly
until it gets to the 16th file, where I get the infamous Run-time
Error 1004. The line where I get the error can be found between the
****** (towards the end of the code).

If I take out the 16th file and re-run the macro, it again stops at
the 16th file (used to be the 17th) -- so, I'm 99% sure that it's not
data file related, but something in my code.

All data files are named identically, with only the 1st three digits
being different. I'm using XL2003 on XP ... any help is greatly
appreciated ...
[I'm sure there's some 'junk' code (ie unused variables) in this --
I've been tinkering for days with it .... ]

Sub FetchStoreData()
Dim MyPath, getstore As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount, x As Long
Dim Fnum, i As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim ws, sh As Worksheet

MyPath = "\\retus100-nt0009\common_b\na-cash\US\DailySales\2007
Daily Sales\"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

' On Error GoTo CleanUp

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
'clear all cells on all sheets
For Each ws In basebook.Worksheets
ws.UsedRange.ClearContents
Next

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), 0)

' Isolates the store number from the workbook name
getstore = Left(mybook.Name, 3)

Set sourceRange = mybook.Sheets("Store
SRA").Range("F:AF").EntireColumn

Set destrange = basebook.Sheets(getstore).Range("A1")

With sourceRange
Set destrange =
basebook.Sheets(getstore).Range("A1").Resize(.Rows.Count, .Columns.Count)
End With
'****** destrange.Value = sourceRange.Value
'******
mybook.Close savechanges:=False
Next
End If

Call ConsData 'consolidates data from store tabs to USA tab

CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

[Ray]

I suspect you are exceeding some limits in excel. I think your copying may
be using the clipboard without you realizing this. when the failure coours
go to worksheet and open on view Menu - Task Pane. The down arrow (next to
X) select clipboard. see if there are a lot of items in clipboard.

One possible fix is follows:

from:
destrange.Value = sourceRange.Value
to:
sourcerange.copy destination:=destrange

Let me know it this works. I believe when copying between worksheets
sometimes excel uses the clipboard.

Hi All -

I'm like to use the following code to 'consolidate' data from approx
30 external data files into one Master file. The code works perfectly
until it gets to the 16th file, where I get the infamous Run-time
Error 1004. The line where I get the error can be found between the
****** (towards the end of the code).

If I take out the 16th file and re-run the macro, it again stops at
the 16th file (used to be the 17th) -- so, I'm 99% sure that it's not
data file related, but something in my code.

All data files are named identically, with only the 1st three digits
being different. I'm using XL2003 on XP ... any help is greatly
appreciated ...
[I'm sure there's some 'junk' code (ie unused variables) in this --
I've been tinkering for days with it .... ]

Sub FetchStoreData()
Dim MyPath, getstore As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount, x As Long
Dim Fnum, i As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim ws, sh As Worksheet

MyPath = "\\retus100-nt0009\common_b\na-cash\US\DailySales\2007
Daily Sales\"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

' On Error GoTo CleanUp

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
'clear all cells on all sheets
For Each ws In basebook.Worksheets
ws.UsedRange.ClearContents
Next

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), 0)

' Isolates the store number from the workbook name
getstore = Left(mybook.Name, 3)

Set sourceRange = mybook.Sheets("Store
SRA").Range("F:AF").EntireColumn

Set destrange = basebook.Sheets(getstore).Range("A1")

With sourceRange
Set destrange =
basebook.Sheets(getstore).Range("A1").Resize(.Rows.Count, .Columns.Count)
End With
'****** destrange.Value = sourceRange.Value
'******
mybook.Close savechanges:=False
Next
End If

Call ConsData 'consolidates data from store tabs to USA tab

CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Thanks for the suggestions ... I tried altering my code as you
suggested with no change in performance. In fact, the code actually
got 'hung up' and didn't do anything at all!

I did some additional research on your initial assessment (ie filling
up clipboard) and found a quick macro (validated by CPearson) to empty
the clipboard. I put this code at the end of each loop (after the
workbook.close code) so that there was never more than one file's
worth of info on the clipboard. But, again, no improvement in
performance ...

So, anyone have any other ideas on what's going on and/or how to fix
it?