VBA alternative to OFFSET/INDIRECT?

Question

I'm using OFFSET/INDIRECT to pull an array from multiple workbooks. Their formats are similar to one another so I want to use one formula for all, with OFFSET/INDIRECT.

Here's what I have so far in A2:

=OFFSET(INDIRECT("'"&A1&"'!$A$1"),MATCH("Total",INDIRECT("'"&A1&"'!$A:$A"),0),0,2,3)

With A1 being the name of the source workbook - e.g.: My Workbook.xlsx. Then in A4 I have the name of a different source workbook and just copy the formula down to A5 to be:

=OFFSET(INDIRECT("'"&A4&"'!$A$1"),MATCH("Total",INDIRECT("'"&A4&"'!$A:$A"),0),0,2,3)

And so on. However, I have maybe 50 workbooks I need to pull data from, and having all 50 open whenever I need to look at the data isn't ideal. I tried making a simple macro that open all 50 workbooks at once, but I still end up having to close them afterwards and it's tedious.

I tried using the VBA solution from here and here. The new formula looks like this:

=OFFSET(INDIRECTVBA("'"&A1&"'!$A$1"),MATCH("Total",INDIRECTVBA("'"&A1&"'!$A:$A"),0),0,2,3)

And I got a #VALUE! error. How do I fix this? Here's what in VBA:

Public Function INDIRECTVBA(ref_text As String)
    INDIRECTVBA = Application.ThisCell.Parent.Range(ref_text)
End Function

Public Sub FullCalc()
    Application.CalculateFull
End Sub

I'm aware that even if I get this fixed, I still have OFFSET function which also requires the source workbook to be open. What's the alternative to this OFFSET/INDIRECT setup that won't require me to open all the sourcebooks?

Please let me know if there's any confusion.

Answer 1

A Worksheet Change: Excel INDIRECT VBA Alternative

• All source files need to be in the same folder and their relevant worksheets need to have the same (tab) name!

• The following will automatically update the destination sheet (in the workbook containing this code) with formulas, linked to the cells of the source workbooks, when entering data (the source workbook names) in cells A1, A4, A7,... etc., and when values change in the source workbooks.
• If a source workbook was deleted i.e. it cannot be found, the destination sheet will get updated (the retrieved values will get cleared) either by manually running the sub or when the destination workbook opens the next time.

Sheet Module e.g. Sheet1

• Save the workbook as macro-enabled, i.e. .xlsm (.xlsb).
• In Excel, select the destination sheet. Right-click on its tab and select View Code.
• Into the window that opens (sheet module), copy the following code.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    UpdateFromClosedWorkbooks Target
End Sub

• Memorize the sheet's code name at the right of the window's title bar. In the screenshot, it is Sheet1 but it could be different in your case.

ThisWorkbook Module

• If not already, open the View-->Project Explorer. Select your (correct) workbook (could be more open workbooks).
• Double-click ThisWorkbook.

• Note the memorized sheet code name in the screenshot, the one not in parentheses (Sheet1).
• Into the window that opens (ThisWorkbook Module), paste the following code.

Option Explicit

Private Sub Workbook_Open()
    UpdateFromClosedWorkbooks
End Sub

• The title bar of the window shows whether you have the correct window (module) open.

Standard Module e.g. Module1

• Right-click any of the items of your workbook in the Project Explorer and select Insert Module.
• Into the window that opens (standard module), paste the following code.

Option Explicit

Sub UpdateFromClosedWorkbooks(Optional ByVal Target As Variant)
    On Error GoTo ClearError
    
    ' Source (Closed Workbook)
    Const SRC_FOLDER_PATH As String = "C:\Test" ' *****
    Const SRC_SHEET_NAME As String = "Sheet1" ' *****
    Const SRC_SEARCH_STRING As String = "Total"
    Const SRC_COLUMN As String = "A"
    Const SRC_ROW_OFFSET As Long = 1
    Const SRC_COLUMN_OFFSET As Long = 0
    ' Both (the numbers from your formula)
    Const ROWS_COUNT As Long = 2
    Const COLUMNS_COUNT As Long = 3
    ' Destination (Workbook Containing This Code)
    Const DST_FIRST_CELL As String = "A1"
    Const DST_ROW_OFFSET As Long = 1
    Const DST_ROWS_GAP As Long = 0
    Const DST_COLUMN_OFFSET As Long = 0
    
    Dim dws As Worksheet
    If IsMissing(Target) Then '  for 'Workbook_Open'
        Set dws = Sheet1 ' the sheet's code name ' *****
    Else ' for 'Worksheet_Change'
        Set dws = Target.Worksheet
    End If
    
    Dim dcrg As Range, drCount As Long
    
    With dws.Range(DST_FIRST_CELL)
        drCount = dws.Cells(dws.Rows.Count, .Column).End(xlUp).Row - .Row + 1
        If drCount < 1 Then Exit Sub
        Set dcrg = .Resize(drCount)
    End With
        
    Dim drOffset As Long: drOffset = ROWS_COUNT + DST_ROWS_GAP + 1
        
    Dim durg As Range, irg As Range, r As Long
    
    For r = 1 To drCount Step drOffset
        If durg Is Nothing Then
            Set durg = dcrg.Cells(r)
        Else
            Set durg = Union(durg, dcrg.Cells(r))
        End If
    Next r
     
    If IsMissing(Target) Then ' for 'Workbook_Open'
        Set irg = durg
    Else ' for 'Worksheet_Change'
        Set irg = Intersect(durg, Target)
        If irg Is Nothing Then Exit Sub
    End If
    
    Dim drg As Range, dcell As Range, icell As Range
    Dim sName As String, sPath As String, sSheet As String, sAddress As String
        
    Application.EnableEvents = False
    
    For Each icell In irg.Cells
        sName = icell.Value
        Set dcell = icell.Offset(DST_ROW_OFFSET, DST_COLUMN_OFFSET)
        Set drg = dcell.Resize(ROWS_COUNT, COLUMNS_COUNT)
        sPath = SRC_FOLDER_PATH & "\" & sName
        If Len(Dir(sPath)) = 0 Then
            drg.ClearContents
        Else
            sSheet = "'" & SRC_FOLDER_PATH & "\[" & sName & "]" _
                & SRC_SHEET_NAME & "'!"
            dcell.Formula = "=MATCH(""" & SRC_SEARCH_STRING & """," & sSheet _
                & SRC_COLUMN & ":" & SRC_COLUMN & ",0)"
            'dcell.Calculate
            If IsNumeric(dcell.Value) Then
                sAddress = dws.Cells(dcell.Value, SRC_COLUMN) _
                    .Offset(SRC_ROW_OFFSET, SRC_COLUMN_OFFSET).Address(0, 0)
                drg.Formula = "=" & sSheet & sAddress
            End If
        End If
    Next icell
 
ProcExit:
    On Error Resume Next
        Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub
ClearError:
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical
    Resume ProcExit
End Sub

• The title bar of the window shows whether you have the correct window (module) open.
• In this lengthy code, locate the line Set dws = Sheet1 ' the sheet's code name ' ***** and replace Sheet1 with the memorized sheet code name (note that there are no quotes).
• Also, at the beginning of the code, in the 'constants section' (see bottom of screenshot), adjust the path and the sheet name of the source files.