VBA Pull Balances

[Terry Echols]

I'm using Excel 2013.

I want to pull info from two cells across all spreadsheets in a specific folder. I want to pull the customer name (cell F6) and the current balance (cell I39). I only want to pull customers that have a balance > than zero.

All workbooks in this folder have only one sheet named "Statement".

Folder Path: C:\Users\Monica Reynolds\Documents\Customer Spreadsheets\Statements - NEW FORMAT (ONLY pull F6 customer name, not the full path).
Customer Name = F6
Total Due = I39

So I'd like to pull this information from the files in the folder and have column A be "Customer Name" and column B be "Balance" with those as headers.

How can I do this?

The file attached has sample data.

Thanks,
Terry

 

[Nebu]

Duplicate post
http://forum.chandoo.org/threads/vba-pull-purchases.24604/

 

[Terry Echols]

This isn't a duplicate post. This one is asking for VBA code to perform a different task that my other post. This one is pulling customers balances and names ONLY and the other is pulling purchases and other info into a master file.

 

[Nebu]

Hi:

Effectively, I guess this will be the same routine but different columns. If you can get your other file working this will be something to do with reference change in the code.

Thanks

 

[Terry Echols]

OK. I have sort of changed this request a bit. I have two pivot tables on these sheets. One calculates aging, i.e. 0-30 DAYS, 31-60 DAYS, 61-90 DAYS & > 90 DAYS. The other pivot table calculates interest charges based on the aging.

I'd like to pull the following information into a master sheet. And if it can be done, since pivot tables have to be refreshed to update data, the macro would need to do that if possible.

Customer Name: F6
Total Balance: I39
31-60 DAYS: G32
61-90 DAYS: H42
> 90 DAYS: I42

The BOLD part should be the header name.

I have uploaded a zip file with customer sheets for you to test with multiple files. I have included some that causes issues with the other coding you did, i.e. files with & in the name or files that have no data. These files should give you all you need to test all the fields I want to work with. Some have 0 data, some have totals for each of the aging fields.

While I'm versed in programing, I'm not, however, versed in VBA. I was a PHP/MySQL web developer but never really worked with to much VBA. While I may be able to soldier on with reworking your code from the VBA PULL PURCHASES macro you wrote, I'd rather have your help once we get the first one working correctly.

This macro would be fine overwriting existing data. I want to run this one everyday so it can be completely fresh data with every run.

Thanks,
Terry

 

[Nebu]

Hi:

Find the attached. I have calculated the total balances and interest within the code itself. I have created two pivot tables and these table will be refreshed automatically. I was not sure about the layout of the pivot you are looking for. I have created a basic pivot, you can change or manipulate the same.

I have taken care of Ambersand issue in the file name( I forgot to code it in to your other macro ,can you incorporate the following code in to your other macro to take care of Ambersand issue

If InStr(1, objFile.Name, "&") > 0 Then
    objFile.Name = Replace(objFile.Name, "&", "")
End If

This code will replace the Ambersand in your file name with a blank.Let me know with questions if any.

Note: I have code assuming your data will be static and will sit in the 42nd row all the time.

I am unable to upload the file use the following code.

Sub DataExtract()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim i As Long
Dim o As Long
Dim s As Long
Dim objFSO As Object
Dim objFolder As Object
Dim objFile  As Object
Dim rng As Variant
Dim Rrng As Variant
Dim wb As Workbook

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "\Balances\")

For Each objFile In objFolder.Files
        If InStr(objFile, ".xls") Then
            If InStr(1, objFile.Name, "&") > 0 Then
                objFile.Name = Replace(objFile.Name, "&", "")
            End If
            Workbooks.Open (objFile)
        End If
    Set wb = ActiveWorkbook
    i = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row + 1
    wb.Sheets("Statement").Range("F42:I42").Copy
    Sheet1.Range("B" & i).PasteSpecial
    wb.Sheets("Statement").Range("F6").Copy
    Sheet1.Range("A" & i).PasteSpecial
    Application.CutCopyMode = False
    wb.Close

    o = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
    rng = Sheet1.Range("B2:E" & o).Value
    Set Rrng = Sheet1.Range("F2:G" & o)
        For s = 1 To UBound(rng)
            Rrng(s, 1) = Application.WorksheetFunction.Sum(rng(s, 1), rng(s, 2), rng(s, 3), rng(s, 4))
            Rrng(s, 2) = Application.WorksheetFunction.Sum((rng(s, 2) * 0.01), (rng(s, 3) * 0.02), (rng(s, 4) * 0.03))
        Next
Next
ThisWorkbook.RefreshAll
Application.DisplayAlerts = False
Application.ScreenUpdating = True

End Sub

Thanks

 

[Terry Echols]

Hi Nebu:

Thank you so much for the code. It is greatly appreciated.

I was wondering if you could try to upload your file again. I'd like to see your layout of the file as apposed to the macro run that I'm doing.

Also, I tried to run this but it throws an VBA error 400 on the 2nd file. The second file is A & C DRY CLEANING so there is still a problem with the ampersand. I also noticed that the original file name A & C DRY CLEANING after the error has been renamed in my main folder to A C DRY CLEANING.

I understand the striping of the & in the new file run from the macro but I don't want the original file names changed in the main folder.

I have not run the other file for "PURCHASES" yet since the code is changing the names in the original folder.

Here is the code I have:

Sub DataExtract()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim i As Long
Dim o As Long
Dim s As Long
Dim objFSO As Object
Dim objFolder As Object
Dim objFile  As Object
Dim rng As Variant
Dim Rrng As Variant
Dim wb As Workbook

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "\Statements - NEW FORMAT\")

For Each objFile In objFolder.Files
  If InStr(objFile, ".xls") Then
  If InStr(1, objFile.Name, "&") > 0 Then
  objFile.Name = Replace(objFile.Name, "&", "")
  End If
  Workbooks.Open (objFile)
  End If
  Set wb = ActiveWorkbook
  i = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row + 1
  wb.Sheets("Statement").Range("F42:I42").Copy
  Sheet1.Range("B" & i).PasteSpecial
  wb.Sheets("Statement").Range("F6").Copy
  Sheet1.Range("A" & i).PasteSpecial
  Application.CutCopyMode = False
  wb.Close

  o = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
  rng = Sheet1.Range("B2:E" & o).Value
  Set Rrng = Sheet1.Range("F2:G" & o)
  For s = 1 To UBound(rng)
  Rrng(s, 1) = Application.WorksheetFunction.Sum(rng(s, 1), rng(s, 2), rng(s, 3), rng(s, 4))
  Rrng(s, 2) = Application.WorksheetFunction.Sum((rng(s, 2) * 0.01), (rng(s, 3) * 0.02), (rng(s, 4) * 0.03))
  Next
Next
ThisWorkbook.RefreshAll
Application.DisplayAlerts = False
Application.ScreenUpdating = True

End Sub

Thanks,
Terry

 

[Nebu]

Hi:

Please find the attached. I am not sure why it is throwing you an error, it is running fine at my end. It does not matter if the name of the file changes a bit, it will still pull the data from the file as long as it is in any "xls" format and saved in the right folder.

Thanks

 

[Terry Echols]

Hi Nebu:

I have been running this one for sometime now and I have noticed it is pulling ALL to the list whether or not they have a zero balance. One thing to notice, which is where the issue is coming from - I think, is the "&" line/issue I was having beofre. I managed to get the code to stop looking for and thus changing the "&" sign. But I think I might have messed up that part of the code.

The file runs without issues but it pulls all names to the master sheet.

Here is my current code:

Sub DataExtract()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim i As Long
Dim o As Long
Dim s As Long
Dim objFSO As Object
Dim objFolder As Object
Dim objFile  As Object
Dim rng As Variant
Dim Rrng As Variant
Dim wb As Workbook

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "\Statements\")

 For Each objFile In objFolder.Files
  If InStr(objFile, ".xls") > 0 Then
  Workbooks.Open (objFile)
  End If
  Set wb = ActiveWorkbook
  i = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row + 1
  wb.Sheets("Statement").Range("F42:I42").Copy
  Sheet1.Range("B" & i).PasteSpecial
  wb.Sheets("Statement").Range("F6").Copy
  Sheet1.Range("A" & i).PasteSpecial
  Application.CutCopyMode = False
  wb.Close

  o = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
  rng = Sheet1.Range("B2:E" & o).Value
  Set Rrng = Sheet1.Range("F2:G" & o)
  For s = 1 To UBound(rng)
  Rrng(s, 1) = Application.WorksheetFunction.Sum(rng(s, 1), rng(s, 2), rng(s, 3), rng(s, 4))
  Rrng(s, 2) = Application.WorksheetFunction.Sum((rng(s, 2) * 0.01), (rng(s, 3) * 0.02), (rng(s, 4) * 0.03))
  Next
Next
ThisWorkbook.RefreshAll
Application.DisplayAlerts = False
Application.ScreenUpdating = True

MsgBox "Task Complete!"

End Sub

This part:

 For Each objFile In objFolder.Files
  If InStr(objFile, ".xls") > 0 Then
  Workbooks.Open (objFile)
  End If

Used to be:

For Each objFile In objFolder.Files
  If InStr(objFile, ".xls") Then
  If InStr(1, objFile.Name, "&") > 0 Then
  objFile.Name = Replace(objFile.Name, "&", "")
  End If
  Workbooks.Open (objFile)
  End If

I'm not sure what I may have done but it no longer pulls only accounts with a balance higher than zero.

Thanks,
Terry Echols

 

[Nebu]

Hi:

I am afraid I understood you correctly, do the macro still open the files which contains an ampersand in the file name, if yes the issue is not in the changes you made to the code. What I understood from your post is that the code is pulling info from those files where the balances are zero and you do not want the info from these files to be pulled into the master file. If that is the case I would suggest you to take out these info with some if condition and loops. If I remember correctly you where checking for a particular status in the data and will pull only if that status is met, if you can tweak the if condition logic given for pulling the data based on status I guess you will be alright. Let me know with questions if any.

Thanks

 

[Terry Echols]

Hi:

The object of this macro is/was to pull all customers with a balance higher than "0" in cell I:39 "Total Due".

You may be confused with the other macro to pull purchases. That one is data specific with "Invoice #".

Here are two files. The "START HERE" file shows the sheet before I run the macro. If you go to the "Master" tab you'll see the way the file starts out, the data you used to create the file and preform the first run is there. The data is also the same on the other two tabs, Amount & Interest.

The second file "START HERE - FINAL" shows after the macro is ran. You'll see the part that was there prior to running is still there on the "Master" sheet and those customers have also been duplicated. On the other two tabs, Amount & Interest, these same customers have not been duplicated, the existing data that was there has been replaced/overwritten by the new data. Shouldn't that be the same on the "Master" sheet?

You'll see that the file does pull and process customers with an "&" in the name but ALL customers are being pulled not just those with a balance.

Now that I've been working with this for a while I'd like to see if a few changes could be implemented as well as get the macro to pull only customers with a > 0 balance.

I'm not sure if it was your original code or something I did after running the macro but I'd like to add "Grand Totals" across the bottom and add a new column to the right of "Interest" labeled "Total Due" and it will add the Interest column and the "Total Balance" column and I'd like to change the name of "Total Balance" to "Balance". And is there a way to make all the money cells use "currency" as the format? Also, I'd like to move the start/header line down one row and add a title in cell A:1 "End of ??? Balance Report". Is there a way to make the programming use the current month when the report is ran so that the ??? is filled in with the current months full name (mmmm)? And is there a way to make all the headers from the pivot table automatically drop the "sum of " part of the label and also format all the money cells (not the grand totals) as "currency" and the grand totals on all pages format as "accounting"? And on "Amount" & "Interest" pages, move up to start on row 1 not 3 and make "Row Labels" use "Customer Name".

Also, this takes a long time, more than 5 min. for 530 files, to run. Is there a way to speed it up? When I run this macro the computer resources are so used that I can't open other files, Excel or other. The file, when running, blinks the document title at the top but occasionally it displays the title larger then normal and freezes. If you click the page the title shows (not responding) but eventually the fill completes. I have had on a couple of occasions when it freezes that the macro does not complete. I think if it could be sped up this issue might go away.

I have tried to delete all the info from the sheet before running it, including refreshing the pivot table so it shows (blank), but I can't delete line one from the master which becomes just a blank line when the macro is ran. How do we get the macro to fill in the info starting at the first line under the headers?

I run this weekly for my assistant but run it one last time for the whole month on the last day of the month. Isn't the info supposed to be overwritten no matter what? If so, why does that info that I start with, or the blank line, not get overwritten or in the case of the first line on the master sheet not get used?

You can see the code used in the file itself. Let me know if you need anything from me.

Thanks,
Terry

 

[Nebu]

Hi:

I have tried incorporating most of your requests. The pivot table grand totals cannot be formatted separately.I have change the headings and totals to the table and have included the new column you have requested.I could not test it here you will have to test it at your end and let me know which of your above request have not been addressed, it is lot to take in . I do not remember many of the specifics of your file, I guess 75% of what you have asked is being done. Let me know with questions if any. The speed at which the macro runs will be based upon the speed of your machine, you are opening 500 plus files and transferring data . I have not understood your request for excluding data with zero balances which column I should consider for this?

Thanks

 

[Terry Echols]

Hey:

Thanks so much for all of your work. It's greatly appreciated.

The "Balance" column/cell to use to pull only customers with a balance > than 0 is I:39. How do I incorporate that into the current code and where?

Also, in the new file you sent, the new column you added "Total Due" in the "Totals" section is showing "$39,232.46$121.09" in the cell. So it has it's own total with the total of the "Interest" column but they are not being added together.

Thanks,
Terry

 

[Nebu]

Hi:

For the total highlight the cell where it is showing "$39,232.46$121.09" You will get a drop down select the appropriate calc you want.

For excluding the files with balances = 0 you will have to incorporate an If condition before

wb.Sheets("Statement").Range("F42:I42").Copy

saying

If wb.Sheets("Statement").Range("I39") = 0 Then GoTo Nextfile

and between next statements include

Nextfile:

Note:

I have not tested this code, you will have to do it at your end. I presume rest all the changes I have made is working fine for you, Let me know.

Thanks

 

[Terry Echols]

Hey:

The zip file contains some sheets and the folders layout as I have them here. So you have folder "Customer Spreadsheets" then in that folder is folder "Statements" which houses the sheets and the Macro file used to generate the report. There are 23 sheets in the folder that should give you all possibilities, blank, with a balance, with & in the name, etc.

This is my process. I have the main file with macro saved to my machine. In order not to screw up the MASTER COPY, I copy it to my folder and then run it from there. This way I always have the BLANK MASTER, at least I will when all is working correctly. So the way you see the file "TEST MACRO CODE BALANCES"

When I run it, no matter what I do I cannot get this to write to table1. It always writes starting on the line after the totals row. It adds amounts to "Balance", "Interest" and "Total Due" - all $0.00 in table1. Nothing gets written to the totals line. All customers start writting on the first line after the totals, line 5.

It is still pulling customers that have a 0 balance but I have a question on this. I have that cell (I39) formated as "Accounting" which does not show the $0.00 like "Currency" does it shows "-", would that be the problem with finding the balance > 0? I do have that cell (I39) copied to another cell (B43) but that cell is "merged" would it still consider it B43 for coding purposes? That cell is formatted as currency and shows $0.00 when they have no balance. If this is not the issue with the code finding accounts and writing accounts with an actual balance then what?

Also, I know it is a known issue with Excel but when this gets ran a good number of the sheets are turned to "Manual" calculation - it took me forever to figure that out. Is there something, in the code other than what you have, to make all of them turn back to "Automatic" calculation?

I hope all of this makes sense to you. If not ask.

Terry

 

[Nebu]

Hi:

Find the attached. I have fixed it , I guess it is working to your specifications let me know with questions if any.



Thanks

 

[Terry Echols]

You're the Excel VBA Master! Thank you so much.

Yay! One last thing, I think.

I think there is only one more issue as far as I can tell. I have one spreadsheet, uploaded here, that is slightly different than the rest. With this company I have to keep a column for their WO numbers. I thought by moving it outside all the other formulas it would be ok - I added it to column J. The issue with this sheet seems to be where the information is on the sheet and where it puts it when the macro runs - one column to the right.

In other words, as you can see on the "Master" sheet, the 0-30 days shows in 31-60 days and all the way across. How do I take care of this one? This setup is only on this one client.

On the Master sheet they are on line 41 "Home Solutions...".

And I'm not sure why/how but some of the data appears in red and some not. The informaion is coming from the same place so why the different colors? It's easy enough to change before printing but I'm curious.

Terry

 

[Nebu]

Hi:

For Home solutions the quick fix is to change the range from G42:J42 to F42:I42 before running the macro. I do not want to make the code more complicated just for this one of issue. The color of the font can be taken care by simply changing the font color, I guess once you change the color it will remain as it is as we are doing a pastespecial using the code.

Note: Every time when you run the macro I am assuming that you will clear all the contents in the Master tab, if not, in the code instead of i=1, give i = Sheet1.Range("A1").CurrentRegion.Rows.Count - 1 so that the starting row will be dynamic.

Thanks

 

[Terry Echols]

What I had in mind with this one was to run it weekly (Monday) with one final for the month ran on the last day of the month. I suppose clearing the master tab data first would work ok in this scenario don't you think?

I'd like to incorporate the week number at the end of this line but can't figure out how to do it:

Sheet1.Range("A1") = "Balances as of: " & Format(Date, "mmmm d, yyyy") & ""

Example:
Balances as of: Thursday, September 10, 2015, Week 37

I'm using the 2015 week numbers here (not sure if it matters for your programing):
http://week-number.net/calendar-with-week-numbers-2015.html

What makes more sense to you? Leave the code the way it is now and run it Monday's and the end of the month deleting the master tab data or incorporate your new code above and continue to run it Monday's and end of the month without clearing the Master tab?

Also, there are two instances of i = 1, one is simply "i = 1" then further down there is "i = 1 + 1". Which code line would I change?

Thanks,
Terry

 

[Nebu]

Hi:
For including week use the following code

Sheet1.Range("A1") = "Run Date: " & Format(Date, "mmmm d, yyyy") & " ,Week " & Format(Date, "ww")

I guess if you run it again at the end of the month you will be duplicating the weekly runs. I am not sure why you want to run it weekly and again monthly, ideally weekly runs should give you data for the month at the end of 4 weeks right? Or is there any business reason for you to do a monthly run?

Replace the code I had given in the previous post where it is , i=1.

Thanks

 

[Terry Echols]

I was thinking the same thing last night. I'm just going to do weekly runs from here on out.

Thank you so much. You've been a great help.

Terry

 

[Terry Echols]

Hi Nebu:

I have been running this file every Monday for months now with no issues. Suddenly today it's throwing error:

run time error '-2147221080 (800401a8)'

I have not changed anything here on my end. Same folders, same programming, all sheets created from the exact same template, etc...

I have included some files in the zip. If you have questions let me know.

I have the line highlighted in red that it throws the error on. Also, it did this on a few different files. I ran it, it failed, I removed the file ran it again and a different file caused the error. I did this several times before I decided to ask for your help again.

Here is the programming (the file is in the zip also):

Sub DataExtract()

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
End With

Dim i As Long
Dim o As Long
Dim s As Long
Dim objFSO As Object
Dim objFolder As Object
Dim objFile  As Object
Dim rng As Variant
Dim Rrng As Variant
Dim wb As Workbook
Dim CTable As ListObject

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "\Statements\")
Set CTable = Sheet1.ListObjects("Table1")
CTable.ShowTotals = False
i = 1
For Each objFile In objFolder.Files
  If InStr(objFile, ".xls") Then
  Workbooks.Open (objFile)
  End If
  Set wb = ActiveWorkbook
  If Application.WorksheetFunction.Sum(wb.Sheets("Statement").Range("F42:I42")) = 0 Then GoTo Nextfile
  wb.Sheets("Statement").Range("F42:I42").Copy
  CTable.DataBodyRange(i, 2).PasteSpecial
  wb.Sheets("Statement").Range("F6").Copy
  CTable.DataBodyRange(i, 1).PasteSpecial
  Application.CutCopyMode = False
  wb.Close
  With CTable
  .DataBodyRange(i, 6) = Application.WorksheetFunction.Sum(.DataBodyRange(i, 2), .DataBodyRange(i, 3), .DataBodyRange(i, 4), .DataBodyRange(i, 5))
  .DataBodyRange(i, 7) = Application.WorksheetFunction.Sum((.DataBodyRange(i, 3) * 0.01), (.DataBodyRange(i, 4) * 0.02), (.DataBodyRange(i, 5) * 0.03))
  .DataBodyRange(i, 8) = .DataBodyRange(i, 6) + .DataBodyRange(i, 7)
  .ListColumns(2).TotalsCalculation = xlTotalsCalculationSum
  .ListColumns(3).TotalsCalculation = xlTotalsCalculationSum
  .ListColumns(4).TotalsCalculation = xlTotalsCalculationSum
  .ListColumns(5).TotalsCalculation = xlTotalsCalculationSum
  .ListColumns(6).TotalsCalculation = xlTotalsCalculationSum
  .ListColumns(7).TotalsCalculation = xlTotalsCalculationSum
  .ListColumns(8).TotalsCalculation = xlTotalsCalculationSum
  End With
  i = i + 1
Nextfile:
On Error Resume Next
wb.Close
Next

CTable.ShowTotals = True
ThisWorkbook.RefreshAll
Sheet1.Range("A1") = "Balances: " & Format(Date, "mmmm d, yyyy") & ", Week " & Format(Date, "ww")
'Align & Format Date text cell
Range("A1").RowHeight = 30
Range("A1").Font.Name = "Arial"
Range("A1").Font.Size = 16
Range("A1").IndentLevel = 1
Range("A1").VerticalAlignment = xlCenter
Range("A1").HorizontalAlignment = xlGeneral

MsgBox "Task Complete!"

With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

Thanks,
Terry

 

[Nebu]

Hi:

I ran the macro at my end and it is working fine with me, I cannot replicate the error you are getting at your end. Did you try running the code in a different machine.

Thanks

 

[Terry Echols]

Hey:

I ran it on a different machine this morning and it worked. What could I have done to my local Excel copy that I should check? I've never experienced this so I don't know what or where to look for a problem. Should I repair/re-install Excel?

Thanks,
Terry

 

[Chihiro]

Usually the error code "run time error '-2147221080 (800401a8)'" indicates some sort of automation error. Often caused by variable/object not pointing to the intended instance of application.

Try stepping through your code and see if active window/object and code has conflict.

FYI - It is usually safer to code with "Thisworkbook." or other prefix when you are opening multiple workbooks when you run the code.

Did you have more application/Excel workbook open when you ran it on your machine?