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?

**Bob Phillips** · 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 :-)

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

Thread Tools

Display

Open Multiple Files in a Folder, List file name, and calculate Average of Column

Posting Permissions