Pull data from specific cell in Multiple Workbooks

lumpy

New Member
Joined
Feb 19, 2004
Messages
2
I have a folder containing .xls workbooks
The workbooks are all in monthly subfolders.
These workbooks are invoices.
The workbooks each have an invoice total in sheet 1 cell H2.
The files are all named with the customers lastnamefirstinitial.xls.

I would like to be able to click a button in a workbook and have it go and open each workbook in the folder and all subfolders. I would like pull the data from each workbook sheet 1 cell H2 into the current workbook. I would like to sum all of the totals from each worksheet into a cell in the current worksheet.
It would be nice to have each invoice total listed in the same column with the total of all invoices in that column in the next column.

Any pointers would be greatly appreciated.
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
You will need to adapt this a bit :-

Code:
Sub PROCESS_FILES()
    Dim MyFolder As String
    Dim MyFile As String
    Dim MyValue As Double
    '--------------------
    MyValue = 0
    MyFolder = "C:\temp\"
    MyFile = Dir(MyFolder & "*.XLS")
    Do While MyFile <> ""
        Application.StatusBar = MyFile
        Workbooks.Open FileName:=MyFolder & MyFile
        MyValue = MyValue + ActiveWorkbook.Sheets(1).Range("H2").Value
        ActiveWorkbook.Close savechanges:=False
        MyFile = Dir
    Loop
    ThisWorkbook.Sheets(1).Range("H2").Value = MyValue
    MsgBox (MyValue)
    Application.StatusBar = False
End Sub
 

lumpy

New Member
Joined
Feb 19, 2004
Messages
2
Thank You for the promt help.

But being the newbie I am, I still need some more help.

How do I modify this code to run on the folder and all subfolders
 

gio123bg

Active Member
Joined
Feb 14, 2004
Messages
255
Hi,
I have tested the following condition.


C:\tmp\dir1\file1.xls
C:\tmp\dir2\file2.xls

I copy a value from last sheet in file1 and file1 (both sheet12) on my book1.sheet1 where I have defined my macro and found in C:\xx\yy\zz\kkk

Sub findremotevalues()
Dim MyFolder As String
Dim RootClaim As String
Dim MyFile As String
Dim MyValue As Double
Dim myArray(50) As String
'--------------------
RootDir = "C:\tmp\"
MyFolder = Dir(RootDir, vbDirectory)
MyFolder = Dir
MyFolder = Dir

dirtemp = RootDir & Dir(RootDir, vbDirectory)
MyFolder = Dir
' after the folder "." and ".."
i = 1
MyFolder = Dir
Dim ii As Integer
Erase myArray
ii = 0
Do While MyFolder <> ""
ii = ii + 1
myArray(ii) = MyFolder
MyFolder = Dir
Loop

j = 1
dirtemp = RootDir & myArray(j) & "\"
MyFile = Dir(dirtemp & "*.xls")
Do While MyFile <> ""
Application.StatusBar = MyFile
Workbooks.Open Filename:=dirtemp & MyFile
MyValue = ActiveWorkbook.Sheets(14).Range("C20").Value
ThisWorkbook.Sheets(1).Range("C20").Value = MyValue
Sheet1.Cells(i, 1) = MyValue
'MyValue = MyValue + ActiveWorkbook.Sheets(1).Range("H2").Value
ActiveWorkbook.Close savechanges:=False
j = j + 1
dirtemp = RootDir & myArray(j) & "\"
Loop
End Sub


Giovanni
 

MartinK

Active Member
Joined
Oct 30, 2003
Messages
384
Hi Lumpy,
just regarding file search in subdirectories:
I like filesearch

Code:
Sub FindMe()
With Application.FileSearch
    .NewSearch
    .LookIn = "C:\YourPathHere\"
    .SearchSubFolders = True
    .Filename = "*.xls" 'or any other wildcard

    If .Execute() > 0 Then
        MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found."
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With
End Sub


Combine this with Brian's code and you'll get what you want. :biggrin:
Regards
Martin
 

Watch MrExcel Video

Forum statistics

Threads
1,127,632
Messages
5,625,994
Members
416,149
Latest member
Bigpotato 668

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