PDA

View Full Version : Open Multiple Files in a Folder, List file name, and calculate Average of Column



jyurasek02
03-01-2016, 11:24 AM
I have excel files that we will be getting every week, and they always have the data in column B that we need to average.

I need a macro that opens all the files in the current folder, lists the file name, and calculates the average of all numeric values of column B.

I'm very new to VBA, and I don't really know what I'm doing. I tried copying a few things from other scripts, but couldn't get it to work.

I've listed the code I have now, and attached a sample of the data I need to average along with the file I want to run the calc. The thought is that we would put the new data into a new folder each time we get it, copy this test file to run the script. Then just copy and paste the results into a master spreadsheet somewhere that we can manipulate and sort.

Private Sub FindAverages_Click()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim myAvg As Integer
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(Application.ActiveWorkbook.Path)
i = 1
'loops through each file in the directory and prints their names
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 1) = objFile.Name

Set wb = Workbooks.Open(fileName:=myPath & objFile)

myAvg = wb.WorksheetFunction.Average(B)

'print file path
Cells(i + 1, 2) = myAvg

wb.Close SaveChanges:=False

i = i + 1
Next objFile
End Sub

JKwan
03-01-2016, 01:19 PM
give this a spin

Private Sub FindAverages_Click()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

Dim myAvg As Double

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim LastRow As Long

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object
Set objFolder = objFSO.GetFolder(Application.ActiveWorkbook.Path)
i = 1
Application.ScreenUpdating = False
'loops through each file in the directory and prints their names
For Each objFile In objFolder.Files
'print file name
If (objFile.Name <> "Test-v1.xlsm") And (objFile.Name <> "~$Test-v1.xlsm") Then
Cells(i + 1, 1) = objFile.Name

Set wb = Workbooks.Open(fileName:=myPath & objFile)
LastRow = FindLastRow(ActiveSheet, "B")
myAvg = Application.WorksheetFunction.Average( _
ActiveSheet.Range("B2:B" & LastRow))

'print file path
Cells(i + 1, 2) = myAvg

wb.Close SaveChanges:=False

i = i + 1
End If
Next objFile
Application.ScreenUpdating = True
End Sub

jyurasek02
03-01-2016, 02:10 PM
I updated the info, and got an error that said "Sub or Function not defined" with FindLastRow highlighted in this string:

LastRow = FindLastRow(ActiveSheet, "B")

jyurasek02
03-01-2016, 02:26 PM
I updated the info, and got an error that said "Sub or Function not defined" with FindLastRow highlighted in this string:

LastRow = FindLastRow(ActiveSheet, "B")

JKwan
03-01-2016, 02:28 PM
Sorry, forgot to put it in

Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

jyurasek02
03-01-2016, 03:22 PM
Where do I insert that? I'm really not that good at this programming stuff.

Here's my new string, but it's not working... Says unexpected end sub.

Private Sub FindAverages_Click()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

Dim myAvg As Double

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim LastRow As Long

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object
Set objFolder = objFSO.GetFolder(Application.ActiveWorkbook.Path)
i = 1
Application.ScreenUpdating = False
'loops through each file in the directory and prints their names
For Each objFile In objFolder.Files
'print file name
If (objFile.Name <> "Test-v1.xlsm") And (objFile.Name <> "~$Test-v1.xlsm") Then
Cells(i + 1, 1) = objFile.Name
Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

Set wb = Workbooks.Open(fileName:=myPath & objFile)
LastRow = FindLastRow(ActiveSheet, "B")
myAvg = Application.WorksheetFunction.Average( _
ActiveSheet.Range("B2:B" & LastRow))

'print file path
Cells(i + 1, 2) = myAvg

wb.Close SaveChanges:=False

i = i + 1
End If
Next objFile
Application.ScreenUpdating = True
End Sub

JKwan
03-01-2016, 05:28 PM
Just add a module and put the Function in there

jyurasek02
03-02-2016, 09:35 AM
Awesome! Works great.

One more question. If I wanted to start opening the files, adding some columns (for day of week and hour of day) so that I can filter out weekends and weeknights, how much more difficult would that be? I'd almost want to the entire average, then a filtered average, maximum value, minimum value, standard deviation, etc.

JKwan
03-02-2016, 10:16 AM
put up example files and see what I can do (and of course what the values should be, I am not statistic guy)

jyurasek02
03-02-2016, 12:39 PM
]See attached. The highlighted columns and rows is the information I'd like to insert.

Then report the Average, Filtered Average, Min, Max, etc to the Test file where the script lives.

JKwan
03-02-2016, 02:00 PM
based on the input file, this is what I have for you, give it a test drive

Private Sub FindAverages_Click()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim LastRow As Long
Dim WS As Worksheet
Dim Output As Worksheet

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Output = ThisWorkbook.Worksheets("Sheet1")
'Get the folder object
Set objFolder = objFSO.GetFolder(Application.ActiveWorkbook.Path)
i = 2
Application.ScreenUpdating = False
'loops through each file in the directory and prints their names
For Each objFile In objFolder.Files
'print file name
If (objFile.Name <> "Test-v1.xlsm") And (objFile.Name <> "~$Test-v1.xlsm") Then
Cells(i, 1) = objFile.Name

Set wb = Workbooks.Open(fileName:=myPath & objFile)
Set WS = ActiveSheet
LastRow = FindLastRow(WS, "B")

'print file path
Output.Cells(i, 2) = Application.WorksheetFunction.Average( _
WS.Range("B2:B" & LastRow))

Output.Cells(i, 3) = Application.WorksheetFunction.AverageIfs(WS.Range("B2:B2282"), _
WS.Range("D2:D" & LastRow), "<7", _
WS.Range("D2:D" & LastRow), ">1", _
WS.Range("E2:E" & LastRow), "<19", _
WS.Range("E2:E" & LastRow), ">6")
Output.Cells(i, 4) = Application.WorksheetFunction.Min( _
WS.Range("B2:B" & LastRow))
Output.Cells(i, 5) = Application.WorksheetFunction.Max( _
WS.Range("B2:B" & LastRow))
Output.Cells(i, 6) = Application.WorksheetFunction.StDevP( _
WS.Range("B2:B" & LastRow))

wb.Close SaveChanges:=False

i = i + 1
End If
Next objFile
Application.ScreenUpdating = True
End Sub

jyurasek02
03-02-2016, 02:49 PM
Gave me an error that said:

Unable to get the AverageIfs property of the WorksheetFunction class

JKwan
03-02-2016, 03:19 PM
hmm, weird. I will attach my file for you

jyurasek02
03-02-2016, 05:02 PM
Yeah, still doesn't work. Maybe I have some setting in excel unchecked or something...

JKwan
03-02-2016, 05:15 PM
Well, I don't know what to say, works for me.

JKwan
03-03-2016, 06:45 AM
out of curiosity, are you running this with the example data file?

xld
03-03-2016, 06:56 AM
What Excel version do you have?

JKwan
03-03-2016, 07:17 AM
ok, I know why you are getting that error. What happened is that the AverageIfs was not able to get valid calculation based on your criteria. I put in error trapping for you, here is the amended code.


Private Sub FindAverages_Click()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim LastRow As Long
Dim WS As Worksheet
Dim Output As Worksheet

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Output = ThisWorkbook.Worksheets("Sheet1")
'Get the folder object
Set objFolder = objFSO.GetFolder(Application.ActiveWorkbook.Path)
i = 2
LastRow = FindLastRow(Output, "A")
If LastRow > 1 Then
Output.Range("A2:F" & LastRow).Clear
End If
Output.Range("B1:F1") = Array("Average", "Filtered Average", "Min", "Max", "Std Dev")
Application.ScreenUpdating = False
'loops through each file in the directory and prints their names
On Error GoTo HandleError
For Each objFile In objFolder.Files
'print file name
If (objFile.Name <> "Test-v1.xlsm") And (objFile.Name <> "~$Test-v1.xlsm") Then
Cells(i, 1) = objFile.Name

Set wb = Workbooks.Open(fileName:=myPath & objFile)
Set WS = ActiveSheet
LastRow = FindLastRow(WS, "B")

'print file path
Output.Cells(i, 2) = Application.WorksheetFunction.Average( _
WS.Range("B2:B" & LastRow))

Output.Cells(i, 3) = Application.WorksheetFunction.AverageIfs(WS.Range("B2:B" & LastRow), _
WS.Range("D2:D" & LastRow), "<7", _
WS.Range("D2:D" & LastRow), ">1", _
WS.Range("E2:E" & LastRow), "<19", _
WS.Range("E2:E" & LastRow), ">6")
Output.Cells(i, 4) = Application.WorksheetFunction.Min( _
WS.Range("B2:B" & LastRow))
Output.Cells(i, 5) = Application.WorksheetFunction.Max( _
WS.Range("B2:B" & LastRow))
Output.Cells(i, 6) = Application.WorksheetFunction.StDevP( _
WS.Range("B2:B" & LastRow))

wb.Close SaveChanges:=False

i = i + 1
End If
Next objFile
Application.ScreenUpdating = True
Exit Sub

HandleError:
MsgBox "Error - " & Err.Description & " - " & objFile.Name
Resume Next
End Sub

jyurasek02
03-03-2016, 08:12 AM
It works! Thank you!

What's the best book resource to learn more about this VBA coding stuff for excel? We need to get better at it in our office...

JKwan
03-03-2016, 08:30 AM
Glad that is working for you, now. As to resources..... Sorry, I don't have an answer for you. I more or less learned as I go - for the past eon or so :-)