Applying the same filter and operations to multiple sheets

[colormestacy]

Hi there,

New here, but I'm wondering if there's a time saving solution to a data processing issue I've encountered.

I have multiple files with 20+ sheets. All sheets have the same headers; they correspond to measurements from different experiments.

I need to do the following to each:

1) Filter 'Area' column for measurements between 10 and 100
2) Calculate the AVERAGE of all 'Area' column measurements post-filter
3) Calculate the AVERAGE of all 'Intensity' column measurements post-filter
4) Divide the the result from (3) by the result from (2)
5) Create a new sheet where the results from (2), (3), and (4) from each sheet are listed in a single row of three different columns

A challenge is that each sheet has different measurements, so the filter will produce different numbers of rows per sheet.

Any thoughts on how to create a macro to expedite this would be greatly appreciated.

Stace

 

[colormestacy]

When you pressed Debug, which particular line of code was highlighted yellow?

Filename = Application.GetOpenFilename _
(filefilter:="Excel files (*.xlsx),*.xlsx", MultiSelect:=False)

 

[kevin9999]

Filename = Application.GetOpenFilename _
(filefilter:="Excel files (*.xlsx),*.xlsx", MultiSelect:=False)

Thanks Stace, leave it with me.

 

[colormestacy]

Thanks Stace, leave it with me.

It may have to do with the fact that I'm running Excel on MacOS?

 

[kevin9999]

It may have to do with the fact that I'm running Excel on MacOS?

Yes, that's right. I just need to work out the Mac equivalent of the open file method. Could you record a macro going through the process of opening a file and post the code?

 

[colormestacy]

Yes, that's right. I just need to work out the Mac equivalent of the open file method. Could you record a macro going through the process of opening a file and post the code?

' Macro3 Macro
Workbooks.Open FileName:= _
"path/to/file.csv"
End Sub

 

[kevin9999]

I have no idea whether this will work or not (don't have a Mac to test it) but it still works in a Windows environment. Copy all of the code - including the Function. See how it goes...

Option Explicit
Sub Stace_V3()
    'Declare variables
    Dim wb As Workbook, ws As Worksheet
    Dim Filename, N As String, i As Long, j As Long
    Dim a As Double, b As Double, c As Double
    
    'Get user to open file
    #If Mac Then
    FilesToOpen = Select_File_Or_Files_Mac()
    #Else
    Filename = Application.GetOpenFilename _
    (filefilter:="Excel files (*.xlsx),*.xlsx", MultiSelect:=False)
    If Filename = False Then
        MsgBox "No file selected"
        Exit Sub
    End If
    #End If
    Set wb = Workbooks.Open(Filename)
    
    'Check if the sheet "Summary" already exists
    'If it does - clear it; If it doesn't - create it
    For i = 1 To wb.Worksheets.Count
        If wb.Worksheets(i).Name = "Summary" Then
            j = 1
        End If
    Next i
    If j = 1 Then
        Set ws = wb.Worksheets("Summary")
        ws.Cells.ClearContents
    Else
        wb.Worksheets.Add(before:=wb.Worksheets(1)).Name = "Summary"
        Set ws = wb.Worksheets("Summary")
    End If
    
    'Add headers to Summary Sheet
    With ws.Cells(1).Resize(, 4)
        .Value = Array("Sheet", "Area (avg)", "Intensity (avg)", "Intensity/Area")  '<~~ change as you see fit
        .ColumnWidth = 30
        .Font.Bold = True
    End With
    
    'Loop through each sheet extracting values & placing in Summary sheet
    For i = 2 To wb.Worksheets.Count
        Set ws = wb.Worksheets(i)
        N = ws.Name
        a = WorksheetFunction.AverageIfs(ws.Columns(2), ws.Columns(2), ">10", ws.Columns(2), "<100")
        b = WorksheetFunction.AverageIfs(ws.Columns(7), ws.Columns(2), ">10", ws.Columns(2), "<100")
        c = b / a
        
        With wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1)
            .Resize(, 4).Value2 = Array(N, a, b, c)
        End With
    Next i
    
    'Tidy up
    With wb.Worksheets(1)
        .Columns("A:D").AutoFit
        .Columns("B:D").NumberFormat = "0.00"   '<~~ change to your desired number format
    End With
    Application.Goto Reference:=wb.Worksheets(1).Range("A1"), scroll:=True
End Sub

Function Select_File_Or_Files_Mac() As String()
    Dim MyPath As String
    Dim MyScript As String
    Dim MyFiles As String
    Dim MySplit As Variant
    Dim N As Long
    Dim FName As String
    Dim mybook As Workbook
    
    On Error Resume Next
    MyPath = MacScript("return (path to documents folder) as String")
    'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"

    ' In the following statement, change true to false in the line "multiple
    ' selections allowed true" if you do not want to be able to select more
    ' than one file. Additionally, if you want to filter for multiple files, change
    ' {""com.microsoft.Excel.xls""} to
    ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
    ' if you want to filter on xls and csv files, for example.
    MyScript = _
    "set applescript's text item delimiters to "","" " & vbNewLine & _
               "set theFiles to (choose file of type " & _
             " {""com.microsoft.excel.xls"",""public.comma-separated-values-text"", ""public.text""} " & _
               "with prompt ""Please select a file or files"" default location alias """ & _
               MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
               "set applescript's text item delimiters to """" " & vbNewLine & _
               "return theFiles"

    MyFiles = MacScript(MyScript)
    Dim returnList() As String
    On Error GoTo 0

    If MyFiles <> "" Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
    'MsgBox MyFiles
    MySplit = Split(MyFiles, ",")
    
    ReDim returnList(1 To UBound(MySplit) + 1)
    
    For N = LBound(MySplit) To UBound(MySplit)
        returnList(N + 1) = MySplit(N)
    Next N
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    Select_File_Or_Files_Mac = returnList
    Else
        ReDim returnList(1 To 1)
        returnList(1) = "False"
        Select_File_Or_Files_Mac = returnList
    End If
End Function

 

[kevin9999]

Small edit:

Option Explicit
Sub Stace_V4()
    'Declare variables
    Dim wb As Workbook, ws As Worksheet
    Dim Filename, N As String, i As Long, j As Long
    Dim a As Double, b As Double, c As Double
    
    'Get user to open file
    #If Mac Then
    Filename = Select_File_Or_Files_Mac()
    #Else
    Filename = Application.GetOpenFilename _
    (filefilter:="Excel files (*.xlsx),*.xlsx", MultiSelect:=False)
    If Filename = False Then
        MsgBox "No file selected"
        Exit Sub
    End If
    #End If
    Set wb = Workbooks.Open(Filename)
    
    'Check if the sheet "Summary" already exists
    'If it does - clear it; If it doesn't - create it
    For i = 1 To wb.Worksheets.Count
        If wb.Worksheets(i).Name = "Summary" Then
            j = 1
        End If
    Next i
    If j = 1 Then
        Set ws = wb.Worksheets("Summary")
        ws.Cells.ClearContents
    Else
        wb.Worksheets.Add(before:=wb.Worksheets(1)).Name = "Summary"
        Set ws = wb.Worksheets("Summary")
    End If
    
    'Add headers to Summary Sheet
    With ws.Cells(1).Resize(, 4)
        .Value = Array("Sheet", "Area (avg)", "Intensity (avg)", "Intensity/Area")  '<~~ change as you see fit
        .ColumnWidth = 30
        .Font.Bold = True
    End With
    
    'Loop through each sheet extracting values & placing in Summary sheet
    For i = 2 To wb.Worksheets.Count
        Set ws = wb.Worksheets(i)
        N = ws.Name
        a = WorksheetFunction.AverageIfs(ws.Columns(2), ws.Columns(2), ">10", ws.Columns(2), "<100")
        b = WorksheetFunction.AverageIfs(ws.Columns(7), ws.Columns(2), ">10", ws.Columns(2), "<100")
        c = b / a
        
        With wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1)
            .Resize(, 4).Value2 = Array(N, a, b, c)
        End With
    Next i
    
    'Tidy up
    With wb.Worksheets(1)
        .Columns("A:D").AutoFit
        .Columns("B:D").NumberFormat = "0.00"   '<~~ change to your desired number format
    End With
    Application.Goto Reference:=wb.Worksheets(1).Range("A1"), scroll:=True
End Sub

Function Select_File_Or_Files_Mac() As String()
    Dim MyPath As String
    Dim MyScript As String
    Dim MyFiles As String
    Dim MySplit As Variant
    Dim N As Long
    Dim FName As String
    Dim mybook As Workbook
    
    On Error Resume Next
    MyPath = MacScript("return (path to documents folder) as String")
    'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"

    ' In the following statement, change true to false in the line "multiple
    ' selections allowed true" if you do not want to be able to select more
    ' than one file. Additionally, if you want to filter for multiple files, change
    ' {""com.microsoft.Excel.xls""} to
    ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
    ' if you want to filter on xls and csv files, for example.
    MyScript = _
    "set applescript's text item delimiters to "","" " & vbNewLine & _
               "set theFiles to (choose file of type " & _
             " {""com.microsoft.excel.xls"",""public.comma-separated-values-text"", ""public.text""} " & _
               "with prompt ""Please select a file or files"" default location alias """ & _
               MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
               "set applescript's text item delimiters to """" " & vbNewLine & _
               "return theFiles"

    MyFiles = MacScript(MyScript)
    Dim returnList() As String
    On Error GoTo 0

    If MyFiles <> "" Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
    'MsgBox MyFiles
    MySplit = Split(MyFiles, ",")
    
    ReDim returnList(1 To UBound(MySplit) + 1)
    
    For N = LBound(MySplit) To UBound(MySplit)
        returnList(N + 1) = MySplit(N)
    Next N
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    Select_File_Or_Files_Mac = returnList
    Else
        ReDim returnList(1 To 1)
        returnList(1) = "False"
        Select_File_Or_Files_Mac = returnList
    End If
End Function

 

[colormestacy]

Small edit:

Option Explicit
Sub Stace_V4()
    'Declare variables
    Dim wb As Workbook, ws As Worksheet
    Dim Filename, N As String, i As Long, j As Long
    Dim a As Double, b As Double, c As Double
  
    'Get user to open file
    #If Mac Then
    Filename = Select_File_Or_Files_Mac()
    #Else
    Filename = Application.GetOpenFilename _
    (filefilter:="Excel files (*.xlsx),*.xlsx", MultiSelect:=False)
    If Filename = False Then
        MsgBox "No file selected"
        Exit Sub
    End If
    #End If
    Set wb = Workbooks.Open(Filename)
  
    'Check if the sheet "Summary" already exists
    'If it does - clear it; If it doesn't - create it
    For i = 1 To wb.Worksheets.Count
        If wb.Worksheets(i).Name = "Summary" Then
            j = 1
        End If
    Next i
    If j = 1 Then
        Set ws = wb.Worksheets("Summary")
        ws.Cells.ClearContents
    Else
        wb.Worksheets.Add(before:=wb.Worksheets(1)).Name = "Summary"
        Set ws = wb.Worksheets("Summary")
    End If
  
    'Add headers to Summary Sheet
    With ws.Cells(1).Resize(, 4)
        .Value = Array("Sheet", "Area (avg)", "Intensity (avg)", "Intensity/Area")  '<~~ change as you see fit
        .ColumnWidth = 30
        .Font.Bold = True
    End With
  
    'Loop through each sheet extracting values & placing in Summary sheet
    For i = 2 To wb.Worksheets.Count
        Set ws = wb.Worksheets(i)
        N = ws.Name
        a = WorksheetFunction.AverageIfs(ws.Columns(2), ws.Columns(2), ">10", ws.Columns(2), "<100")
        b = WorksheetFunction.AverageIfs(ws.Columns(7), ws.Columns(2), ">10", ws.Columns(2), "<100")
        c = b / a
      
        With wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1)
            .Resize(, 4).Value2 = Array(N, a, b, c)
        End With
    Next i
  
    'Tidy up
    With wb.Worksheets(1)
        .Columns("A:D").AutoFit
        .Columns("B:D").NumberFormat = "0.00"   '<~~ change to your desired number format
    End With
    Application.Goto Reference:=wb.Worksheets(1).Range("A1"), scroll:=True
End Sub

Function Select_File_Or_Files_Mac() As String()
    Dim MyPath As String
    Dim MyScript As String
    Dim MyFiles As String
    Dim MySplit As Variant
    Dim N As Long
    Dim FName As String
    Dim mybook As Workbook
  
    On Error Resume Next
    MyPath = MacScript("return (path to documents folder) as String")
    'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"

    ' In the following statement, change true to false in the line "multiple
    ' selections allowed true" if you do not want to be able to select more
    ' than one file. Additionally, if you want to filter for multiple files, change
    ' {""com.microsoft.Excel.xls""} to
    ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
    ' if you want to filter on xls and csv files, for example.
    MyScript = _
    "set applescript's text item delimiters to "","" " & vbNewLine & _
               "set theFiles to (choose file of type " & _
             " {""com.microsoft.excel.xls"",""public.comma-separated-values-text"", ""public.text""} " & _
               "with prompt ""Please select a file or files"" default location alias """ & _
               MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
               "set applescript's text item delimiters to """" " & vbNewLine & _
               "return theFiles"

    MyFiles = MacScript(MyScript)
    Dim returnList() As String
    On Error GoTo 0

    If MyFiles <> "" Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
  
    'MsgBox MyFiles
    MySplit = Split(MyFiles, ",")
  
    ReDim returnList(1 To UBound(MySplit) + 1)
  
    For N = LBound(MySplit) To UBound(MySplit)
        returnList(N + 1) = MySplit(N)
    Next N
  
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
  
    Select_File_Or_Files_Mac = returnList
    Else
        ReDim returnList(1 To 1)
        returnList(1) = "False"
        Select_File_Or_Files_Mac = returnList
    End If
End Function

Thanks for all of this.

I copy-pasted this last version, added the path to my test file and ran. The following error message popped up: "Type mismatch" and debugging pointed to this line of code:

Set wb = Workbooks.Open(Filename)

 

[kevin9999]

I'm not sure I can resolve the above problem (with my lack of Mac programming skills) but I can suggest a workaround:
Open a file that you want to apply the summary to. Add a module to it & copy/paste the following code. Run the code (you don't have to save as a macro-enabled file first). See if it's giving you the result you're looking for.

Option Explicit
Sub Stace_Test()
    'Declare variables
    Dim wb As Workbook, ws As Worksheet
    Dim n As String, i As Long, j As Long
    Dim a As Double, b As Double, c As Double
   
   
    Set wb = ThisWorkbook
   
    'Check if the sheet "Summary" already exists
    'If it does - clear it; If it doesn't - create it
    For i = 1 To wb.Worksheets.Count
        If wb.Worksheets(i).Name = "Summary" Then
            j = 1
        End If
    Next i
    If j = 1 Then
        Set ws = wb.Worksheets("Summary")
        ws.Cells.ClearContents
    Else
        wb.Worksheets.Add(before:=wb.Worksheets(1)).Name = "Summary"
        Set ws = wb.Worksheets("Summary")
    End If
   
    'Add headers to Summary Sheet
    With ws.Cells(1).Resize(, 4)
        .Value = Array("Sheet", "Area (avg)", "Intensity (avg)", "Intensity/Area")  '<~~ change as you see fit
        .ColumnWidth = 30
        .Font.Bold = True
    End With
   
    'Loop through each sheet extracting values & placing in Summary sheet
    For i = 2 To wb.Worksheets.Count
        Set ws = wb.Worksheets(i)
        n = ws.Name
        a = WorksheetFunction.AverageIfs(ws.Columns(2), ws.Columns(2), ">10", ws.Columns(2), "<100")
        b = WorksheetFunction.AverageIfs(ws.Columns(7), ws.Columns(2), ">10", ws.Columns(2), "<100")
        c = b / a
       
        With wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1)
            .Resize(, 4).Value2 = Array(n, a, b, c)
        End With
    Next i
   
    'Tidy up
    With wb.Worksheets(1)
        .Columns("A:D").AutoFit
        .Columns("B:D").NumberFormat = "0.00"   '<~~ change to your desired number format
    End With
    Application.Goto Reference:=wb.Worksheets(1).Range("A1"), scroll:=True
End Sub