almost got it, but need help- pulling data from other workbooks

[KR]

I have about 300 workbooks (different users, all in the same network
directory) and now I need to pull data out of the same worksheet for each
user- into one workbook so I can run some statistics on all the data
combined.

For testing purposes, my code is below, but I'm having trouble getting it to
paste (then close) properly.

Info: Win2000, Excel 2003
Each workbook's data sheet is protected, so I need to unprotect it (to copy)
then reprotect it before exiting
Each workbook has an onopen even that links it to a third workbook to upload
the most current source data for some worksheets in the workbook
Each workbook's before_close event includes code that saves the workbook as
part of the close (no warnings or pop-ups)

Once I get this working for one workbook, it should be easy to modify the
code to loop through each workbook in the target network directory.

Thanks for helping,
Keith


Sub GrabMyData()

Dim Owkbk As Workbook
Set Owkbk = ActiveWorkbook

Dim wkbk As Excel.Workbook

On Error Resume Next
Set wkbk = Workbooks.Open(\\mynetworkpath\ & "filename" & ".xls", 0,
True)
On Error GoTo 0

wkbk.Activate
'wkbk.Sheet1.Unprotect
wkbk.Sheets("Data Entry").Unprotect
wkbk.Sheets("Data Entry").Activate
LastRow = wkbk.Sheets("Data Entry").Cells.Find(What:="*", After:=[A1],
SearchDirection:=xlPrevious).Row
wkbk.ActiveSheet.Range("A13:Z" & Trim(Str(LastRow))).Select
Selection.Copy
Application.CutCopyMode = False

Owkbk.Activate
Owkbk.Sheets("Sheet1").Range("A1").Select
Owkbk.ActiveSheet.Paste ' ******* it doesn't like this line *******

wkbk.Activate
wkbk.Sheet1.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
wkbk.Sheet1.EnableSelection = xlNoSelection
wkbk.Close (False)

End Sub

 

[Ron de Bruin]

Start here KR
http://www.rondebruin.nl/copy3.htm

 

[KR]

Ron-
Awesome page! Thanks for the pointers. I've tried adapting example 2
(network files) but am still having trouble getting all the information I
need, and I'm at a loss for why. I disabled error handling in case that
could provide a flag, but it isn't throwing an error. I also thought someone
might have a workbook open, so I changed the open info to readonly thinking
that would help... but no luck.

Based on the code (below), here is some critical info:

UBound(MyFiles) = 263
code ended without any error or warning on Fnum 152 (leaving that workbook
open on my PC)

FWIW, it brought data over from 25 of 44 workbooks that I know currently
have data in them (the rest may not have data yet, which is fine).

Each of these workbooks is essentially identical except for the actual data
in the "Data Entry" Sheet starting on row 13. Column A always contains the
date of the entry (all entrys are pasted from a userform, so they are all
standardized).

I suspect the problem has to do with the complexity of the code in the data
workbooks. I can post it, if anyone wants to muddle through it to look for
possible problems. In summary though:
The "data entry" sheet starts as veryhidden, and each workbook's open event
(if macros are enabled) unhides it. I've added code below to unprotect it as
well so I can select the designated cells. Then I have to put everything
back the way I found it so the workbook will function properly the next time
it is opened by the user (the before_close event automatically saves the
workbook without any prompts).

Any ideas on why the code might stop unexpectedly without any errors or
warnings? Many thanks,
Keith

Sub Example2()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long

'Fill in the path\folder where the files are
'MyPath = "C:\Data" or on a network :
MyPath = "\\mynetworkpath\myfolder\"

'Add a slash at the end if the user forgot 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.ScreenUpdating = False 'commented out for error checking,
add in later for speed
Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Clear
rnum = 2 'start at 2 when pasting, to leave header row intact

'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)

'lets me verify how many workbooks have been processed
Application.StatusBar = "Processing " & Fnum & " of " &
UBound(MyFiles)
'open as readonly
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), 0, True)
'unprotect the data sheet so I can select the cells
mybook.Sheets("Data Entry").Unprotect
mybook.Sheets("Data Entry").Activate
'only process the file if there has been at least one data entry
If mybook.Sheets("Data Entry").Range("A13").Value <> "" Then
'find the last used row, only copy the rows that have data
MyLast = mybook.Sheets("Data Entry").Cells.Find(What:="*",
After:=[A1], SearchDirection:=xlPrevious).Row
Set sourceRange = mybook.Sheets("Data Entry").Range("A13:Z"
& Trim(Str(MyLast)))
SourceRcount = sourceRange.Rows.Count

Set destrange = basebook.Sheets(1).Range("B" & rnum)

' This will add the workbook name in column A
basebook.Worksheets(1).Cells(rnum, "A").Value = mybook.Name

sourceRange.Copy destrange

rnum = rnum + SourceRcount
End If
'reprotect the sheet before closing the workbook
mybook.Sheets("Data Entry").Protect DrawingObjects:=True,
Contents:=True, Scenarios:=True
mybook.Sheets("Data Entry").EnableSelection = xlNoSelection
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

Try to disable the events (See Tips)
You do not have to unprotect or activate the sheet to do the copy
Remove this code from your example

See this page where I use a function to find the last row with data
http://www.rondebruin.nl/copy3.htm#header


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

Ron-
Awesome page! Thanks for the pointers. I've tried adapting example 2
(network files) but am still having trouble getting all the information I
need, and I'm at a loss for why. I disabled error handling in case that
could provide a flag, but it isn't throwing an error. I also thought someone
might have a workbook open, so I changed the open info to readonly thinking
that would help... but no luck.

Based on the code (below), here is some critical info:

UBound(MyFiles) = 263
code ended without any error or warning on Fnum 152 (leaving that workbook
open on my PC)

FWIW, it brought data over from 25 of 44 workbooks that I know currently
have data in them (the rest may not have data yet, which is fine).

Each of these workbooks is essentially identical except for the actual data
in the "Data Entry" Sheet starting on row 13. Column A always contains the
date of the entry (all entrys are pasted from a userform, so they are all
standardized).

I suspect the problem has to do with the complexity of the code in the data
workbooks. I can post it, if anyone wants to muddle through it to look for
possible problems. In summary though:
The "data entry" sheet starts as veryhidden, and each workbook's open event
(if macros are enabled) unhides it. I've added code below to unprotect it as
well so I can select the designated cells. Then I have to put everything
back the way I found it so the workbook will function properly the next time
it is opened by the user (the before_close event automatically saves the
workbook without any prompts).

Any ideas on why the code might stop unexpectedly without any errors or
warnings? Many thanks,
Keith

Sub Example2()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long

'Fill in the path\folder where the files are
'MyPath = "C:\Data" or on a network :
MyPath = "\\mynetworkpath\myfolder\"

'Add a slash at the end if the user forgot 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.ScreenUpdating = False 'commented out for error checking,
add in later for speed
Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Clear
rnum = 2 'start at 2 when pasting, to leave header row intact

'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)

'lets me verify how many workbooks have been processed
Application.StatusBar = "Processing " & Fnum & " of " &
UBound(MyFiles)
'open as readonly
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), 0, True)
'unprotect the data sheet so I can select the cells
mybook.Sheets("Data Entry").Unprotect
mybook.Sheets("Data Entry").Activate
'only process the file if there has been at least one data entry
If mybook.Sheets("Data Entry").Range("A13").Value <> "" Then
'find the last used row, only copy the rows that have data
MyLast = mybook.Sheets("Data Entry").Cells.Find(What:="*",
After:=[A1], SearchDirection:=xlPrevious).Row
Set sourceRange = mybook.Sheets("Data Entry").Range("A13:Z"
& Trim(Str(MyLast)))
SourceRcount = sourceRange.Rows.Count

Set destrange = basebook.Sheets(1).Range("B" & rnum)

' This will add the workbook name in column A
basebook.Worksheets(1).Cells(rnum, "A").Value = mybook.Name

sourceRange.Copy destrange

rnum = rnum + SourceRcount
End If
'reprotect the sheet before closing the workbook
mybook.Sheets("Data Entry").Protect DrawingObjects:=True,
Contents:=True, Scenarios:=True
mybook.Sheets("Data Entry").EnableSelection = xlNoSelection
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub

Start here KR
http://www.rondebruin.nl/copy3.htm

 

[KR]

Woot!

Disable events did the trick- I disabled them for both opening and closing
the other workbook, so in addition to getting all my data, the whole process
has been sped up at least 200%! I also took out the unprotect and activate
code per your suggestion, and it all works great!

Many, many, many thanks!
Keith

Try to disable the events (See Tips)
You do not have to unprotect or activate the sheet to do the copy
Remove this code from your example

See this page where I use a function to find the last row with data
http://www.rondebruin.nl/copy3.htm#header


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

Ron-
Awesome page! Thanks for the pointers. I've tried adapting example 2
(network files) but am still having trouble getting all the information I
need, and I'm at a loss for why. I disabled error handling in case that
could provide a flag, but it isn't throwing an error. I also thought someone
might have a workbook open, so I changed the open info to readonly thinking
that would help... but no luck.

Based on the code (below), here is some critical info:

UBound(MyFiles) = 263
code ended without any error or warning on Fnum 152 (leaving that workbook
open on my PC)

FWIW, it brought data over from 25 of 44 workbooks that I know currently
have data in them (the rest may not have data yet, which is fine).

Each of these workbooks is essentially identical except for the actual data
in the "Data Entry" Sheet starting on row 13. Column A always contains the
date of the entry (all entrys are pasted from a userform, so they are all
standardized).

I suspect the problem has to do with the complexity of the code in the data
workbooks. I can post it, if anyone wants to muddle through it to look for
possible problems. In summary though:
The "data entry" sheet starts as veryhidden, and each workbook's open event
(if macros are enabled) unhides it. I've added code below to unprotect it as
well so I can select the designated cells. Then I have to put everything
back the way I found it so the workbook will function properly the next time
it is opened by the user (the before_close event automatically saves the
workbook without any prompts).

Any ideas on why the code might stop unexpectedly without any errors or
warnings? Many thanks,
Keith

Sub Example2()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long

'Fill in the path\folder where the files are
'MyPath = "C:\Data" or on a network :
MyPath = "\\mynetworkpath\myfolder\"

'Add a slash at the end if the user forgot 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.ScreenUpdating = False 'commented out for error checking,
add in later for speed
Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Clear
rnum = 2 'start at 2 when pasting, to leave header row intact

'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)

'lets me verify how many workbooks have been processed
Application.StatusBar = "Processing " & Fnum & " of " &
UBound(MyFiles)
'open as readonly
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), 0, True)
'unprotect the data sheet so I can select the cells
mybook.Sheets("Data Entry").Unprotect
mybook.Sheets("Data Entry").Activate
'only process the file if there has been at least one data entry
If mybook.Sheets("Data Entry").Range("A13").Value <> "" Then
'find the last used row, only copy the rows that have data
MyLast = mybook.Sheets("Data Entry").Cells.Find(What:="*",
After:=[A1], SearchDirection:=xlPrevious).Row
Set sourceRange = mybook.Sheets("Data Entry").Range("A13:Z"
& Trim(Str(MyLast)))
SourceRcount = sourceRange.Rows.Count

Set destrange = basebook.Sheets(1).Range("B" & rnum)

' This will add the workbook name in column A
basebook.Worksheets(1).Cells(rnum, "A").Value = mybook.Name

sourceRange.Copy destrange

rnum = rnum + SourceRcount
End If
'reprotect the sheet before closing the workbook
mybook.Sheets("Data Entry").Protect DrawingObjects:=True,
Contents:=True, Scenarios:=True
mybook.Sheets("Data Entry").EnableSelection = xlNoSelection
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub

Start here KR
http://www.rondebruin.nl/copy3.htm