Summary worksheet | Mac Excel Automation

Create a summary worksheet from different workbooks (formulas created with VBA macro)

Note : Copy the code in a Standard module of your workbook, working in Mac Excel 2016 and higher.

Example 1

This macro will add a new workbook with one worksheet. It will use one row on that sheet for every workbook that you select in the browse dialog. Note: in this example you can only select xls, xlsx and xlsm files, but you can add or remove extensions in the applescript string if you want. For each cell in the Range "A1,D5:E5,Z10" in "Sheet1" it will add a link on that row. It will copy the workbook name in column A and the link to the first cell starts in Column B.

Change the following two lines of code before you run the macro. Each workbook that is selected should contain a sheet name and data range that matches your changes.
Note: If the sheet does not exist in a selected workbook, that row will be highlighted in yellow.

Tip: if you select the first file in the dialog and hold the shift key down and select the last file all files in between are also selected.

ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change

Sub Summary_cells_from_Different_Workbooks_Mac()
    'Ron de Bruin, 16-Dec-2020
    'Select the files you want in folder you select
    'links are created to the cells in this workbooks
    'https://macexcel.com/examples/filesandfolders/summaryworksheet/
    Dim ShName As String
    Dim Rng As Range
    Dim FileFormat As String
    Dim MyPath As String
    Dim MyScript As String
    Dim MyFiles As String
    Dim SummWks As Worksheet
    Dim RwNum As Long
    Dim FileNameXls As Variant
    Dim FNum As Long
    Dim ColNum As Long
    Dim FinalSlash As Long
    Dim JustFileName As String
    Dim JustFolder As String
    Dim PathStr As String
    Dim SheetCheck As String
    Dim myCell As Range
    
    ' Sheet name and cells in each workbook that you select.
    ' It will make a link to each cell in Rng (4 cells in this example)
    ShName = "Sheet1"  '<---- Change
    Set Rng = Range("A1,D5:E5,Z10")    '<---- Change

    'In this example you can only select xls, xlsx and xlsm files
    'See my webpage how to use other and more formats.
    FileFormat = "{""com.microsoft.excel.xls"",""org.openxmlformats.spreadsheetml.sheet""" & _
        ",""org.openxmlformats.spreadsheetml.sheet.macroenabled""}"

    On Error Resume Next
    MyPath = MacScript("return (path to desktop folder) as String")
   
    'Script for Excel 2016 or higher
    MyScript = _
        "set theFiles to (choose file of type" & _
        " " & FileFormat & " " & _
        "with prompt ""Please select a file or files"" default location alias """ & _
        MyPath & """ with multiple selections allowed)" & vbNewLine & _
        "set thePOSIXFiles to {}" & vbNewLine & _
        "repeat with aFile in theFiles" & vbNewLine & _
        "set end of thePOSIXFiles to POSIX path of aFile" & vbNewLine & _
        "end repeat" & vbNewLine & _
        "set {TID, text item delimiters} to {text item delimiters, ASCII character 10}" & vbNewLine & _
        "set thePOSIXFiles to thePOSIXFiles as text" & vbNewLine & _
        "set text item delimiters to TID" & vbNewLine & _
        "return thePOSIXFiles"

    MyFiles = MacScript(MyScript)
    On Error GoTo 0

    If MyFiles <> "" Then

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

        'Add a new workbook with one sheet for the Summary
        Workbooks.Add (1)
        Set SummWks = ActiveWorkbook.Worksheets(1)

        'The links to the first workbook will start in row 2
        RwNum = 1

        FileNameXls = Split(MyFiles, Chr(10))

        For FNum = LBound(FileNameXls) To UBound(FileNameXls)
            ColNum = 1
            RwNum = RwNum + 1
            FinalSlash = InStrRev(FileNameXls(FNum), Application.PathSeparator)
            JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
            JustFolder = Left(FileNameXls(FNum), FinalSlash - 1) & Application.PathSeparator

            'copy the workbook name in column A
            SummWks.Cells(RwNum, 1).Value = JustFileName

            'build the formula string
            JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
            PathStr = "'" & JustFolder & "[" & JustFileName & "]" & ShName & "'!"

            On Error Resume Next
            SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
            If Err.Number <> 0 Then
                'If the sheet not exist in the workbook the row color will be Yellow.
                SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _
                    .Interior.Color = vbYellow
            Else
                For Each myCell In Rng.Cells
                    ColNum = ColNum + 1
                    SummWks.Cells(RwNum, ColNum).Formula = _
                        "=" & PathStr & myCell.Address
                Next myCell
            End If
            On Error GoTo 0
            Next FNum

        ' Use AutoFit to set the column width in the new workbook
        SummWks.UsedRange.Columns.AutoFit
        
        'If you want you can use the code lines below to make values of the formulas
        'With SummWks.UsedRange
        '.Value = .Value
        'End With

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

        Application.Calculate
    End If
End Sub

Example 2

This macro will use an existing worksheet in your workbook (I use "Sheet2" in the example). It will use one row on that sheet for every workbook that you select in the browse dialog. Note: in this example you can only select xls, xlsx and xlsm files, but you can add or remove extensions in the applescript string if you want. For each cell in the Range "A1,D5:E5,Z10" in "Sheet1" it will add a link on that row. It will copy the workbook name in column A and the link to the first cell starts in Column B.

Change the following three lines of code before you run the macro. Each workbook that is selected should contain a sheet name and data range that matches your changes and the SummWks must exist in the destination workbook (workbook with this macro).

ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change
Set SummWks = Sheets("Sheet2") '<---- Change

Every time you run the macro it will add the links below the existing formulas that already on the worksheet. If the sheet not exist in a selected workbook that row will be highlighted in green and if there are already links to a workbook with that name that row will be highlighted in blue.
Note: This macro use the function LastRow that you find below the macro.

Sub Summary_cells_from_Different_Workbooks_Mac_2()
    'Ron de Bruin, 16-Dec-2020
    'Select the files you want in folder you select
    'links are created to the cells in this workbooks
    'in an existing sheet in the workbook with this macro.
    'https://macexcel.com/examples/filesandfolders/summaryworksheet/
    Dim ShName As String
    Dim Rng As Range
    Dim SummWks As Worksheet
    Dim FileFormat As String
    Dim MyPath As String
    Dim MyScript As String
    Dim MyFiles As String
    Dim FileNameXls As Variant
    Dim FNum As Long
    Dim ColNum As Long
    Dim RwNum As Long
    Dim FinalSlash As Long
    Dim JustFileName As String
    Dim JustFolder As String
    Dim fndFileName As Range
    Dim PathStr As String
    Dim SheetCheck As String
    Dim myCell As Range

    ' Sheet name and cells in each workbook that you select.
    ' It will make a link to each cell in Rng (4 cells in this example)
    ShName = "Sheet1"  '<---- Change
    Set Rng = Range("A1,D5:E5,Z10")    '<---- Change

    'We use this sheet for the Summary
    Set SummWks = Sheets("Sheet2")   '<---- Change

    'In this example you can only select xls, xlsx and xlsm files
    'See my webpage how to use other and more formats.
    FileFormat = "{""com.microsoft.excel.xls"",""org.openxmlformats.spreadsheetml.sheet""" & _
        ",""org.openxmlformats.spreadsheetml.sheet.macroenabled""}"

    On Error Resume Next
    MyPath = MacScript("return (path to desktop folder) as String")

    'Excel 2016 or higher
    MyScript = _
        "set theFiles to (choose file of type" & _
        " " & FileFormat & " " & _
        "with prompt ""Please select a file or files"" default location alias """ & _
        MyPath & """ with multiple selections allowed)" & vbNewLine & _
        "set thePOSIXFiles to {}" & vbNewLine & _
        "repeat with aFile in theFiles" & vbNewLine & _
        "set end of thePOSIXFiles to POSIX path of aFile" & vbNewLine & _
        "end repeat" & vbNewLine & _
        "set {TID, text item delimiters} to {text item delimiters, ASCII character 10}" & vbNewLine & _
        "set thePOSIXFiles to thePOSIXFiles as text" & vbNewLine & _
        "set text item delimiters to TID" & vbNewLine & _
        "return thePOSIXFiles"
   
    MyFiles = MacScript(MyScript)
    On Error GoTo 0

    If MyFiles <> "" Then

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

        FileNameXls = Split(MyFiles, Chr(10))
        For FNum = LBound(FileNameXls) To UBound(FileNameXls)
            ColNum = 1
            RwNum = LastRow(SummWks) + 1
            FinalSlash = InStrRev(FileNameXls(FNum), Application.PathSeparator)
            JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
            JustFolder = Left(FileNameXls(FNum), FinalSlash - 1) & Application.PathSeparator

            'If the workbook name already exist the row color will be Green
            Set fndFileName = Nothing
            Set fndFileName = SummWks.Cells.Find(JustFileName)
            If Not fndFileName Is Nothing Then
                SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _
                    .Interior.Color = vbGreen
            Else
                'Do nothing
            End If

            'copy the workbook name in column A
            SummWks.Cells(RwNum, 1).Value = JustFileName

            'build the formula string
            JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
            PathStr = "'" & JustFolder & "[" & JustFileName & "]" & ShName & "'!"

            On Error Resume Next
            SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
            If Err.Number <> 0 Then
                'If the sheet not exist in the workbook the row color will be Yellow.
                SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _
                    .Interior.Color = vbYellow
            Else
                For Each myCell In Rng.Cells
                    ColNum = ColNum + 1
                    SummWks.Cells(RwNum, ColNum).Formula = _
                        "=" & PathStr & myCell.Address
                Next myCell
            End If
            On Error GoTo 0
            Next FNum

        'If you want you can use the code lines below to make values of the formulas
        'With SummWks.UsedRange
        '.Value = .Value
        'End With

        ' Use AutoFit to set the column width
        SummWks.UsedRange.Columns.AutoFit

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

        Application.Calculate
    End If
End Sub



Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
        After:=sh.Range("A1"), _
        Lookat:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
    On Error GoTo 0
End Function