VBA to pull data from dynamically named closed workbooks

[Qliky66]

I've searched through many of the other threads about VBA for retrieving data from closed workbooks but all of them refer to a static address in the VBA itself (ex. C:\folder\folder\filename.xlsx).

In my case I need to run a macro which will update all of the formulas that I have, since they will not pull data from the file I am telling them to unless that file is currently open.

What happens is: our systems automatically generate a new file everyday in the same folder, with a filename of the date that is generated (ex. 01-01-2017), and the data that we want to pull automatically is usually in cell B11 of that, however that may change, so thats the reason we have Row B which would allow us to specify where we want our formula to look.

The problem is: excel wont use this indirect formula to look at the new file since that file is not currently open.
The solution is: a macro button which will force excel to peek in the file and display the data. I just don't know how that will work. So please help me.


The user would will open this file every couple days, drag down the formulas to correspond with the days that have passed, then click the macro button and wait for the data to upload.
Here's the structure:

[TABLE="width: 600"]
<tbody>[TR]
[TD]DATE(rowA)[/TD]
[TD]CELL(RowB)[/TD]
[TD]FORMULA (Row C)[/TD]
[/TR]
[TR]
[TD]01-01-2017[/TD]
[TD]B11[/TD]
[TD]=indirect(" 'C:\folder\[ "&A2&".xlsx]Sheet1'! "&B2)[/TD]
[/TR]
[TR]
[TD]01-02-2017[/TD]
[TD]B11[/TD]
[TD]=indirect(" 'C:\folder\[ "&A3&".xlsx]Sheet1'! "&B3)[/TD]
[/TR]
[TR]
[TD]01-03-2017[/TD]
[TD]B11[/TD]
[TD]=indirect(" 'C:\folder\[ "&A4&".xlsx]Sheet1'! "&B4)[/TD]
[/TR]
</tbody>[/TABLE]

The DATE is the file name that I need the macro to re-open (/open if its the first time).

Your thoughts would be GREATLY appreciated.
Thank you

 

[Qliky66]

Re: VBA to pull data from dynamiccaly named closed workbooks

I got it to work through debugging and adjusting the dir function to this:

If Len(Dir(ThisWorkbook.Path & "\" & Format(.Cells(r, "A").Value, "YYYY-MM-DD") & ".xls")) <> 0 Then

One last question, John, ( I promise! lol).
I have now found that it is quite slow when the number of workbooks gets into the high 100's. Since it is physically opening every workbook everytime. (even if I am clicking it so that it will update April for me, and I have previously ran this script to update March, it'll still open all the march AND all the april, AND January and February even though I wont be looking at that).

Is there a way to adjust this to only consider blank cells in Column B?

So after running March, a month later I'd open this workbook, drag down the dates in Column A so April is now there, run the macro, but I wouldn't want it to re-do any of the old stuff which has been run and 'locked in' (pasted as values).

I guess what I'm asking is, instead of looking at all dates starting at row 7, I would like it to only look at dates in column A if the data in column B is blank.
[TABLE="width: 200"]
<tbody>[TR]
[TD]Jan 1[/TD]
[TD]23
[/TD]
[/TR]
[TR]
[TD]Jan 2[/TD]
[TD]38[/TD]
[/TR]
[TR]
[TD]Jan 3[/TD]
[TD]21[/TD]
[/TR]
[TR]
[TD]Jan 4[/TD]
[TD]32[/TD]
[/TR]
[TR]
[TD]Jan 5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jan 6[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


The full code right now is:

Public Sub Open_Files_and_Create_Formulas_STVL()

    Dim r As Long


    Application.ScreenUpdating = False
    With ThisWorkbook.ActiveSheet
        For r = 7 To .Cells(Rows.Count, "A").End(xlUp).Row


            If Len(Dir(ThisWorkbook.Path & "\" & Format(.Cells(r, "A").Value, "YYYY-MM-DD") & ".xls")) <> 0 Then
            
            Workbooks.Open ThisWorkbook.Path & "\" & Format(.Cells(r, "A").Value, "YYYY-MM-DD") & ".xls"
            .Cells(r, "B").ClearContents
            .Cells(r, "B").Formula = "=INDIRECT(""'" & ThisWorkbook.Path & "\[""&TEXT(A" & r & ",""YYYY-MM-DD"")&"".xls]Sheet1'!""&$A$4)"
        
       Else
       .Cells(r, "B").ClearContents
        .Cells(r, "B").Formula = "NO DATA"
        End If
        Next
        
        .Activate
        
    End With
    Dim Z As Range, X As Range
    Set Z = Range("B7:B400")
    For Each X In Z
        If X.HasFormula And X.Value > 0 Then
            X.Value = X.Value
        End If
    Next X
    
     
     Dim wb As Workbook
    
    For Each wb In Application.Workbooks
        If Not wb Is ThisWorkbook Then
            wb.Close SaveChanges:=True
        End If
    Next
    Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

The Dir function call looks correct and the Workbooks.Open uses the same argument value so the Workbooks.Open should only be executed if the file exists. Try some basic debugging, stepping through the code with the F8 key and add the following code before the Dir call:

            Dim fn As String
            fn = Dir(ThisWorkbook.Path & "\" & Format(.Cells(r, "A").Value, "YYYY-MM-DD") & ".xls")
            MsgBox ThisWorkbook.Path & "\" & Format(.Cells(r, "A").Value, "YYYY-MM-DD") & ".xls" & vbNewLine & "Dir returned """ & fn & """"

 

[John_w]

Re: VBA to pull data from dynamiccaly named closed workbooks

Well done for getting it working. I've seen people use your variant of the Dir function to check whether a file exists:

If Len(Dir(filePath)) <> 0 Then

But the following has always worked for me, so I'm wondering why the first variant is needed.

If Dir(filePath) <> "" Then

To open the workbook only if the column B cell is empty/blank add this extra If block:

        For r = 7 To .Cells(Rows.Count, "A").End(xlUp).Row

            [COLOR=#ff0000][B]If IsEmpty(.Cells(r, "B").Value) Then[/B][/COLOR]
            
                If Len(Dir(ThisWorkbook.path & "\" & Format(.Cells(r, "A").Value, "YYYY-MM-DD") & ".xls")) <> 0 Then
                
                    Workbooks.Open ThisWorkbook.path & "\" & Format(.Cells(r, "A").Value, "YYYY-MM-DD") & ".xls"
                    .Cells(r, "B").ClearContents
                    .Cells(r, "B").Formula = "=INDIRECT(""'" & ThisWorkbook.path & "\[""&TEXT(A" & r & ",""YYYY-MM-DD"")&"".xls]Sheet1'!""&$A$4)"
            
                Else
                
                    .Cells(r, "B").Value = "NO DATA"
                
                End If
            
            [COLOR=#ff0000][B]End If[/B][/COLOR]
            
        Next

You mentioned "pasted as values", so if you only need the cell value from the external workbook, and not the =INDIRECT formula to it, here is a method of getting a cell value from a closed workbook without opening it. This code replaces the above code:

        For r = 7 To .Cells(Rows.Count, "A").End(xlUp).Row

            If IsEmpty(.Cells(r, "B").Value) Then
            
                If Len(Dir(ThisWorkbook.path & "\" & Format(.Cells(r, "A").Value, "YYYY-MM-DD") & ".xls")) <> 0 Then
                
                    .Cells(r, "B").Value = GetCellValue(ThisWorkbook.path, Format(.Cells(r, "A").Value, "YYYY-MM-DD") & ".xls", "Sheet1", "A4")
            
                Else
                
                    .Cells(r, "B").Value = "NO DATA"
                
                End If
            
            End If
            
        Next

and put this function in the module:

Private Function GetCellValue(ByVal path As String, workbookFileName As String, sheetName As String, cellAddress As String)
    
    'Retrieves a cell value from a closed workbook without opening the workbook
    
    Dim arg As String

    'Check whether the workbook exists
    
    If Right(path, 1) <> "\" Then path = path & "\"
    If Len(Dir(path & workbookFileName)) <> 0 Then

        arg = "'" & path & "[" & workbookFileName & "]" & sheetName & "'!" & Range(cellAddress).Address(True, True, xlR1C1)
    
        GetCellValue = ExecuteExcel4Macro(arg)
    
    Else
    
        GetCellValue = "File not found: " & path & workbookFileName
    
    End If

End Function

 

[PIPERIA]

Re: VBA to pull data from dynamiccaly named closed workbooks

An INDIRECT formula which references a cell in another workbook will only pull that cell value if that workbook is open. Otherwise the formula displays the #REF! error.

Therefore this code opens each dated workbook in column A and creates the formula in column C.

Public Sub Open_Workbooks_and_Create_Formulas2()

    Dim r As Long
   
    Application.ScreenUpdating = False
   
    With ThisWorkbook.ActiveSheet
       
        For r = 2 To .Cells(Rows.Count, "A").End(xlUp).Row

            Workbooks.Open ThisWorkbook.Path & "\" & Format(.Cells(r, "A").Value, "DD-MM-YYYY") & ".xlsx"
           
            '=INDIRECT("'C:\folder\path\["&TEXT(A2,"DD-MM-YYYY")&".xlsx]Sheet1'!"&B2)
           
            .Cells(r, "C").ClearContents
            .Cells(r, "C").Formula = "=INDIRECT(""'" & ThisWorkbook.Path & "\[""&TEXT(A" & r & ",""DD-MM-YYYY"")&"".xlsx]Sheet1'!""&B" & r & ")"
           
        Next
       
        .Activate
       
    End With
           
    Application.ScreenUpdating = True
   
End Sub

Hello, your solution is very helpful!

I am trying to adjust to my data and i have the following problem:

My Data:

A (SPREADSHEET_NAME_VALUES)	cell	VALUE
A_1725_400266558_1L	T2
A_4338_400459795_1L	T2
A_5025_400459795_1L	T2

I want the final excel to pull data from cell T2 of source spreadsheets named in column A.
The adjustments are that i do not have a date as a spread name.
It gives me #REF if i use the code you have posted. It opens the spreadsheet but it doesnt pull the data from the cell. I have no idea on VBA, but i am trying to learn.



Public Sub Open_Workbooks_and_Create_Formulas()

Dim r As Long

Application.ScreenUpdating = False

With ThisWorkbook.ActiveSheet


For r = 2 To .Cells(Rows.Count, "A").End(xlUp).Row

Workbooks.Open ThisWorkbook.Path & "\" & Format(.Cells(r, "A").Value, "Standard") & ".xlsx"


'=INDIRECT("'C:\folder\path\["&TEXT(A2,"DD-MM-YYYY")&".xlsx]Sheet1'!"&B2)

' .Cells(Rows.Count, "A").End(xlUp).Row Find the last non-blank cell in column A(1)
.Cells(r, "I").ClearContents
.Cells(r, "I").Formula = "=INDIRECT(""'" & ThisWorkbook.Path & "\[""&A" & r & "&"".xlsx]Revaluation Template'!""B" & r & ")"
Next

.Activate

End With

Application.ScreenUpdating = True

End Sub

 

[John_w]

I am trying to adjust to my data and i have the following problem:

My Data:

A (SPREADSHEET_NAME_VALUES)	cell	VALUE
A_1725_400266558_1L	T2
A_4338_400459795_1L	T2
A_5025_400459795_1L	T2

I want the final excel to pull data from cell T2 of source spreadsheets named in column A.

Try this macro. To make easier to change the INDIRECT formula, the code uses the following string template for the generic INDIRECT formula for referencing a workbook, sheet and cell:

"=INDIRECT(<Q>'[<workbook>]<sheet>'!<cell><Q>)"

and replaces the <workbook>, <sheet> and <cell> parts with actual values from cells or strings. Each <Q> is replaced by a double quote character and avoids the need to put 2 double quote characters inside a VBA string to get 1 double quote inside the string. The final string with everything replaced is the INDIRECT formula put in the destination cell (column C).

Public Sub Open_Workbooks_and_Create_Formulas3()

    Dim workbooksFolder As String
    Dim r As Long
    Dim indirectTemplate As String, indirectFormula As String
    
    workbooksFolder = ThisWorkbook.path
    
    If Right(workbooksFolder, 1) <> "\" Then workbooksFolder = workbooksFolder & "\"
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook.ActiveSheet
        
        For r = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
        
            If Dir(workbooksFolder & .Cells(r, "A").Value & ".xlsx") <> vbNullString Then
            
                Workbooks.Open workbooksFolder & .Cells(r, "A").Value & ".xlsx"
                
                indirectTemplate = "=INDIRECT(<Q>'[<workbook>]<sheet>'!<cell><Q>)"
                
                indirectFormula = Replace(indirectTemplate, "<Q>", Chr(34), Compare:=vbBinaryCompare)
                indirectFormula = Replace(indirectFormula, "<workbook>", .Cells(r, "A").Value & ".xlsx", Compare:=vbBinaryCompare)
                indirectFormula = Replace(indirectFormula, "<sheet>", "Revaluation Template", Compare:=vbBinaryCompare)
                indirectFormula = Replace(indirectFormula, "<cell>", .Cells(r, "B").Value, Compare:=vbBinaryCompare)
                .Cells(r, "C").Formula = indirectFormula
            
            End If
            
        Next
    
        .Activate
        
    End With
            
    Application.ScreenUpdating = True
                
End Sub