Moving data from cells one workbook to another 1

[f0rg3tfu1]

Hi, I have a fairly simple straightforward question:

- I have about 200 forms in excel.

- I have three cells in each workbook (same position in each spreadsheet) which I would like to combine into a "Summary" sheet in a separate workbook

- Cells are "Time In", "Time Out" and "Driving Time", then I will calculate them into "Total Time" on the summary sheet.

Now I am not an excel guru, I can do vlookups and pivot tables but I don't do any VBA scripts or anything. I just want to figure out the most efficient way to put these cells into one sheet and calculate total time without hand typing in.

Any advice is well appreciated!

 

[SkipVought]

hi,

"I have about 200 forms in excel."

I assume from your thread title that this means 200 workbooks. What a horrible design! But maybe you conducted a survey where the workbook had to go out to 200 people.

QUESTIONS:
[pre]
Are these workbooks all in the same folder?

YES: Are these 200 workbooks the ONLY workbooks in this folder?

YES: You will need VBA code to loop through all the files in the folder to OPEN, COPY, PASTE, CLOSE

NO: How will you identify with ones to act on?

NO: Then we will need the full path for each workbook in a list in a sheet, and loop through that list to OPEN, COPY, PASTE, CLOSE.
[/pre]

In any case you WILL need to use VBA.

But lets get the answer to the questions above.

 

[f0rg3tfu1]

Hi Skip,

Not my process, I unfortunately inherited this project from the last employee in this department.

- Are these workbooks all in the same folder? Yes they are

- Are these 200 workbooks the ONLY workbooks in this folder? Yes they are

- I want to move the data from the following cells in the original "form" workbooks into a single "Summary" workbook:

f13, f176, c17​

Each original workbook has the same structure

 

[SkipVought]

...and the name of the folder is?

 

[SkipVought]

Actually, need the PATH and folder name.

 

[f0rg3tfu1]

My bad... here you go:

\\newyork\Wireless_ops\Wireless Field Maintenance\Maint Checklists

 

[SkipVought]

One other clarification:

This folder has all the workbooks and no other files. YES?

If so, paste this untested procedure into a MODULE in your VBAProject.

This procedure assumes that you have Headings in ROW 1 beginning in Column A, as stated in your original post

Sub GatherData()
'loops through \\newyork\Wireless_ops\Wireless Field Maintenance\Maint Checklists
'  to open all files as Excel workbook and
'  get data from f13, f176, c17 and write to
'  the Summary sheet table headings "Time In", "Time Out" and "Driving Time"

    Dim ws As Worksheet         'Summary worksheet object
    Dim lRow As Long            'Summary sheet next Row number
    Dim sFileSpec As String     'path to the folder containing excel files to open and scrape
    Dim oFSO As Object          'File System Application Object
    Dim oFile As Object         'File System File Object
    
    Set ws = Worksheets("Summary")                                  'set the worksheet object
    
    lRow = ws.Cells(1, 1).CurrentRegion.Rows.Count + 1              'assign next row in Summary sheet
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")           'set the File System Application Object
    
    sFileSpec = "\\newyork\Wireless_ops\Wireless Field Maintenance\Maint Checklists"    'assign path
    For Each oFile In oFSO.getfolder(sFileSpec).Files               'start loop for files
        With Workbooks.Open(oFile.Path)                             'open the workbook
            With .ActiveSheet                                       'reference the ActiveSheet in the opened workbook
                ws.Cells(lRow, "A").Value = .Cells(13, "F").Value   'assign the three values from three cells
                ws.Cells(lRow, "B").Value = .Cells(176, "F").Value
                ws.Cells(lRow, "C").Value = .Cells(17, "C").Value
                
                lRow = lRow + 1                                     'incriment the Summary Sheet Row number
            End With
            .Close                                                  'close the opened workbook
        End With
    Next
    
    Set ws = Nothing                                                'set all objects to Nothing
    Set oFile = Nothing
    Set oFSO = Nothing
End Sub

 

[f0rg3tfu1]

So I created a workbook "Summary" in the same folder, I added the script into a module, I run the script and I get:

Run-time error '9'
Subscript out of range

When I click "DEBUG" it highlights this line:

Set ws = Worksheets("Summary") 'set the worksheet object


What am I missing?

 

[SkipVought]

I asked all those lead up question because that folder must contain only and all the workbooks that must be opened to fill the Workbood containing the Summary sheet.

So the workbook containing the sheet named Summary, must ALSO contain the VBA code and therefore must be open BEFORE you ever start the procedure!

 

[f0rg3tfu1]

Oh I got it, had to rename the worksheet itself Summary! Easy fix!

I have two more minor issues...

1st issue:
- when I start the script, each workbook that opens up has a popup:

This workbook contains links to other data sources... etc​

Then

This workbook contains one or more links that cannot be updated...etc​

Links don't need to be updated, just need to pull the data off each sheet. Is there code I can add to just move through?

2nd issue:
- When I get to the end of the workbooks all data dissapears and the "summary" sheet is left blank with just the headers

 

[SkipVought]

After the Set ws statement insert this line

   Application.DisplayAlerts = FALSE

I think this will prevent this dialog.

Second issue:
when these workbooks open, is the ActiveSheet the sheet that has data in F13 etc?

Does F13 et al each have a FORMULA? If so, are there formulas in the Summary sheet for 200 rows?

 

[zelgar]

I think the following change of code will stop the popups for update links:

 With Workbooks.Open(oFile.Path)

to

 With Workbooks.Open(oFile.Path,0)

 

[SkipVought]

Nice tip, zelgar!n Have a STAR

 

[f0rg3tfu1]

After the Set ws statement insert this line
Application.DisplayAlerts = FALSE

I inserted that code and it did not prevent the popups:



Sub GatherData()
'loops through \\newyork\Wireless_ops\Wireless Field Maintenance\Maint Checklists
' to open all files as Excel workbook and
' get data from f13, f176, c17 and write to
' the Summary sheet table headings "Time In", "Time Out" and "Driving Time"

Dim ws As Worksheet 'Summary worksheet object
Dim lRow As Long 'Summary sheet next Row number
Dim sFileSpec As String 'path to the folder containing excel files to open and scrape
Dim oFSO As Object 'File System Application Object
Dim oFile As Object 'File System File Object

Set ws = Worksheets("Summary") 'set the worksheet object

Application.DisplayAlerts = FALSE 'prevent popups

lRow = ws.Cells(1, 1).CurrentRegion.Rows.Count + 1 'assign next row in Summary sheet

Set oFSO = CreateObject("Scripting.FileSystemObject") 'set the File System Application Object

sFileSpec = "\\newyork\Wireless_ops\Wireless Field Maintenance\Maint Checklists" 'assign path
For Each oFile In oFSO.getfolder(sFileSpec).Files 'start loop for files
With Workbooks.Open(oFile.Path) 'open the workbook
With .ActiveSheet 'reference the ActiveSheet in the opened workbook
ws.Cells(lRow, "A").Value = .Cells(13, "F").Value 'assign the three values from three cells
ws.Cells(lRow, "B").Value = .Cells(176, "F").Value
ws.Cells(lRow, "C").Value = .Cells(17, "C").Value

lRow = lRow + 1 'incriment the Summary Sheet Row number
End With
.Close 'close the opened workbook
End With
Next

Set ws = Nothing 'set all objects to Nothing
Set oFile = Nothing
Set oFSO = Nothing
End Sub


Second issue:
when these workbooks open, is the ActiveSheet the sheet that has data in F13 etc?
YES

Does F13 et al each have a FORMULA? If so, are there formulas in the Summary sheet for 200 rows?
NO, F13 does NOT contain a formula.

 

[SkipVought]

First, use zelgar's Workbook.Open modification, where the second argument is 0.

Second, put a break on the statement where F13 is being assigned to column A in the Summary sheet.

run your code to the break and in the break, look at F13 on the ActiveSheet. What value is in F13?

In the VB editor, hover your cursor over [highlight #FCE94F]lRow[/highlight]. what value do you see in the popup?

Then click the STEP icon in the VB Editor to advance the code to the next statement for F176.

Select the Summary sheet. Is the value from F13 in A2?

 

[f0rg3tfu1]

Actually guys I think I got it fixed! The only last problem is how can I have it stop when it hits the "Summary" workbook"? Thats what was making it overwrite the data we put in.

Here's my code:

Sub GatherData()
'loops through \\newyork\Wireless_ops\Wireless Field Maintenance\Maint Checklists
' to open all files as Excel workbook and
' get data from f13, f176, c17 and write to
' the Summary sheet table headings "Time In", "Time Out" and "Driving Time"

Dim ws As Worksheet 'Summary worksheet object
Dim lRow As Long 'Summary sheet next Row number
Dim sFileSpec As String 'path to the folder containing excel files to open and scrape
Dim oFSO As Object 'File System Application Object
Dim oFile As Object 'File System File Object

Set ws = Worksheets("Summary") 'set the worksheet object

'Application.DisplayAlerts = False 'prevent popups

lRow = ws.Cells(1, 1).CurrentRegion.Rows.Count + 1 'assign next row in Summary sheet

Set oFSO = CreateObject("Scripting.FileSystemObject") 'set the File System Application Object

sFileSpec = "\\newyork\Wireless_ops\Wireless Field Maintenance\Maint Checklists" 'assign path
For Each oFile In oFSO.getfolder(sFileSpec).Files 'start loop for files
With Workbooks.Open(oFile.Path, 0) 'open the workbook
With .ActiveSheet 'reference the ActiveSheet in the opened workbook
ws.Cells(lRow, "A").Value = .Cells(13, "F").Value 'assign the three values from three cells
ws.Cells(lRow, "B").Value = .Cells(176, "F").Value
ws.Cells(lRow, "C").Value = .Cells(17, "C").Value

lRow = lRow + 1 'incriment the Summary Sheet Row number
End With
.Close 'close the opened workbook
End With
Next

Set ws = Nothing 'set all objects to Nothing
Set oFile = Nothing
Set oFSO = Nothing
End Sub

 

[SkipVought]

The Summary workbook was not supposed to be in this folder. Just workbooks that your program (in the Summary Workbook) will open.

This is why specifying your requirements clearly, concisely and completely is important.

But here's a modification that will allow the Summary workbook to be stored in the folder.

Sub GatherData()
'loops through \\newyork\Wireless_ops\Wireless Field Maintenance\Maint Checklists
' to open all files as Excel workbook and
' get data from f13, f176, c17 and write to
' the Summary sheet table headings "Time In", "Time Out" and "Driving Time"

    Dim ws As Worksheet         'Summary worksheet object
    Dim lRow As Long            'Summary sheet next Row number
    Dim sFileSpec As String     'path to the folder containing excel files to open and scrape
    Dim oFSO As Object          'File System Application Object
    Dim oFile As Object         'File System File Object
    
    Set ws = Worksheets("Summary")                                  'set the worksheet object
    
    lRow = ws.Cells(1, 1).CurrentRegion.Rows.Count + 1              'assign next row in Summary sheet
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")           'set the File System Application Object
    
    sFileSpec = "\\newyork\Wireless_ops\Wireless Field Maintenance\Maint Checklists"    'assign path
    For Each oFile In oFSO.getfolder(sFileSpec).Files               'start loop for files[b]
        If oFile.Name <> "Summary.xlsm" Then                        'this should be your Summary workbook name[/b]
            With Workbooks.Open(oFile.Path, 0)                          'open the workbook
                With .ActiveSheet                                       'reference the ActiveSheet in the opened workbook
                    ws.Cells(lRow, "A").Value = .Cells(13, "F").Value   'assign the three values from three cells
                    ws.Cells(lRow, "B").Value = .Cells(176, "F").Value
                    ws.Cells(lRow, "C").Value = .Cells(17, "C").Value
                    
                    lRow = lRow + 1                                     'incriment the Summary Sheet Row number
                End With
                .Close                                                  'close the opened workbook
            End With
        End If
    Next
    
    Set ws = Nothing                                                'set all objects to Nothing
    Set oFile = Nothing
    Set oFSO = Nothing
End Sub

 

[f0rg3tfu1]

Got it! Works perfect!

Thanks Skip and Zelgar!