VBA Code to copy and paste a total from one file into another

Problem: I have 10 Excel sales forecast files of varying rows and columns. Each file contains a grand total in the last column, second to last row's cell. Today I have to manually open these 10 files, write down these grand totals, then add them up on a calculator. I would like to have a macro that would open each file, grab the grand total (leaving file open) go to the next file, etc. and when all 10 are opened somehow present a total of the 10 grand totals, thereby eliminating the need to do this manually. The files are named salesperson1.xls through salesperson10.xls and lets assume they are stored on my C:\ root.
thx experts...
BobR
bobrossi56Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may try something like this.....

'Library Reference required: Microsoft Scripting Runtime

Option Explicit

Sub GetGrandTotalFromSalespersonWorkbooks()
Dim fso As Scripting.FileSystemObject
Dim sFolderPath As String
Dim fil As Scripting.File
Dim sFolder As Scripting.Folder
Dim ws As Worksheet
Dim GTotal As Double
Dim lr As Long, lc As Long

Application.ScreenUpdating = False
Set fso = New Scripting.FileSystemObject

sFolderPath = "C:\root"
If fso.FolderExists(sFolderPath) Then
    Set sFolder = fso.GetFolder(sFolderPath)
Else
    MsgBox "Folder " & sFolderPath & " doesn't exist.", vbCritical, "Folder Not Found!"
End If

For Each fil In sFolder.Files
    If Left(fso.GetExtensionName(fil), 2) = "xl" And LCase(fil.Name) Like "salesperson*" Then
        Workbooks.Open fil
        Set ws = ActiveWorkbook.Sheets(1)
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
        GTotal = GTotal + ws.Cells(lr, lc)
    End If
Next fil
ThisWorkbook.Sheets("Sheet1").Range("A2").Value = GTotal
MsgBox "Grand Total from all the Salesperson's workbooks is " & GTotal
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

Open in new window


Please find the attached workbook and click on the Get Grand Total button on sheet1 to get the Grand Total in cell A2.
Get-Grand-Total.xlsm
bobrossi56Author Commented:
OK, ran this and it opened 2 of my 10 Excel files and then errored on this line
GTotal = GTotal + ws.Cells(lr, lc)
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Are you using a formula to get the total in those worksheets and does this formula returns a blank?
Also when the code produces an error, click on debug and hover your mouse over lr (row number) and lc (column number) to know their underlying values and look at the corresponding cell in the currently activated workbook and see what is the value of that cell. i.e. if lr=10 and lc=5, look at the cell E10, what value do you find there?
Also make sure the the code is finding the correct row and column number in your opened workbook.
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

bobrossi56Author Commented:
The total is not a formula, it is a fixed number. The reporting tool we use exports the totals as fixed numbers. I did go into debug and discovered the macro was finding several other Excel files on my C:\ drive and those were giving me the error, so I made a C:\test folder and moved the files into there and changed the PATH statement. Then I tried it with just one file, it ran error free but returned the number in the last column and row, instead of the number in the last column and second to last row. The last row is the backlog #, the row above it is the revenue #, we only care about the revenue #. I have attached a sample, small file if that helps. The code returns the grand total as $22,500 and it should be $138,800
thank you
salesperson1.xlsm
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Replace the previous code with the following one and see if you get the correct output....
'Library Reference required: Microsoft Scripting Runtime

Option Explicit

Sub GetGrandTotalFromSalespersonWorkbooks()
Dim fso As Scripting.FileSystemObject
Dim sFolderPath As String
Dim fil As Scripting.File
Dim sFolder As Scripting.Folder
Dim ws As Worksheet
Dim GTotal As Double
Dim lr As Long, lc As Long

Application.ScreenUpdating = False
Set fso = New Scripting.FileSystemObject

sFolderPath = "C:\root"
If fso.FolderExists(sFolderPath) Then
    Set sFolder = fso.GetFolder(sFolderPath)
Else
    MsgBox "Folder " & sFolderPath & " doesn't exist.", vbCritical, "Folder Not Found!"
End If

For Each fil In sFolder.Files
    If Left(fso.GetExtensionName(fil), 2) = "xl" And LCase(fil.Name) Like "salesperson*" Then
        Workbooks.Open fil
        Set ws = ActiveWorkbook.Sheets(1)
        lr = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
        lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
        GTotal = GTotal + ws.Cells(lr, lc)
    End If
Next fil
ThisWorkbook.Sheets("Sheet1").Range("A2").Value = GTotal
MsgBox "Grand Total from all the Salesperson's workbooks is " & GTotal
Set fso = Nothing
Application.ScreenUpdating = True
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bobrossi56Author Commented:
Now we are good. Works great, thx so much
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome. Glad I could help.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.