Reference cell for filename

TBIALEK

New Member
Joined
Mar 18, 2016
Messages
24
Hello, Is there a way to reference a cell containing the filename and use is in the formula? I'd like to pull data from different workbooks saved in the folder.
Workbooks will not be opened. Thanks

Capture.PNG
 

TBIALEK

New Member
Joined
Mar 18, 2016
Messages
24
Replace:

VBA Code:
If Dir(SourceDirectory & SourceFileName & FileExtention) <> "" Then ' If file name exists then ...

with:

VBA Code:
If Dir(SourceDirectory & Sheets(DestinationSheet).Range(SourceFileName) & ".xlsx") <> "" Then ' If file name exists then ...

Thank you, work as intended now.
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

TBIALEK

New Member
Joined
Mar 18, 2016
Messages
24
Sub GetRangeFromClosedWorkbookV6() ' *** Copy data across row *** Check for missing files *** Adds data to table
'
' This file can do single address range as well as multiple cell address ranges
' This file assumes all ranges to be vertical 1D ranges
'
'
' Turn Settings off
Application.ScreenUpdating = False ' Turn Screen Updating off
Application.Calculation = xlCalculationManual ' Turn AutoCalculation off
Application.EnableEvents = False ' Turn EnableEvents off
'
Dim FileNameRow As Long, FirstPartRangeColumnNumber As Long, FirstPartRangeRowNumber As Long, SourceRowOffsetCounter As Long
Dim SourceLastRow As Long, ThisRangeLoopLength As Long, ThisRangeLoopCounter As Long, SourceRangeLoop As Long
'
Dim objCatalog As Object, objConnection As Object, objRecordSet As Object, RowArrayList As Object
'
Dim FileExtention As String, FileNotFoundMessage As String, FirstPartThisRange As String, FirstPartRangeColumnLetter As String
Dim FullFilePathNameExtention As String, ResultColumnLetter As String, SourceDirectory As String, SourceFileAddressColumn As String
Dim SourceFileAddressRow As String, SourceFileName As String, SourceFullRange As String, SourceSheet As String
Dim SourceSheetName As String, strConnect As String, strSQL As String
'
Dim SourceRange As Variant, SourceRangesArray As Variant, SourceWorkbookArray As Variant
'
Dim WS As Worksheet
'
'--------------------------------------------------------------------------------------
'
Set WS = Sheets("Sheet1") ' <--- Set this to the sheet name used to store values from the closed workbook
SourceFileAddressColumn = "F" ' <--- Set this to the column used for Source File Names
SourceFileAddressRow = "3" ' <--- Set this to the start row number used for Source File Names
ResultColumnLetter = "H" ' <--- Set the column to store results in
SourceDirectory = "C:\Test\Data\" ' <--- Set this to the directory of the closed workbooks
FileExtention = ".xlsx" ' <--- Set this to the file extention of the closed workbook(s) ie. .xlsx
FileNotFoundMessage = "FNF" ' <--- set this to cell value indicating file not found
'
' Add/Remove as many ranges that you want
SourceRangesArray = Array("B2:B2", "B3:B3", "C5:C10", "C15:C20") ' <--- Set this to the ranges in the closed workbook to get data from
'
'--------------------------------------------------------------------------------------
'
Set RowArrayList = CreateObject("System.Collections.ArrayList")
'
For FileNameRow = SourceFileAddressRow To WS.Range(SourceFileAddressColumn & SourceFileAddressRow).End(xlDown).Row ' Range of file names to loop through
SourceFileName = WS.Range(SourceFileAddressColumn & FileNameRow) ' Set Address to use for the file name of closed workbook
'
FullFilePathNameExtention = SourceDirectory & SourceFileName & FileExtention ' FullFilePathNameExtention
'
If Dir(SourceDirectory & SourceFileName & FileExtention) <> "" Then ' If file name exists then ...
Set objCatalog = CreateObject("ADOX.Catalog") ' Set up catalog so we can get the sheet name
Set objConnection = CreateObject("ADODB.Connection") ' Set up connection so we can connect to the source file
Set objRecordSet = CreateObject("ADODB.Recordset") ' Set up recordset so we can get the Last row and range values
'
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FullFilePathNameExtention & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
'
On Error GoTo InvalidInput ' If an error is encountered, goto the error handling section
objConnection.Open strConnect ' open the connection to the source file
'
objCatalog.ActiveConnection = objConnection
SourceSheetName = Replace(objCatalog.Tables(0).Name, "$", "") ' Remove $ from end of sheet name
SourceSheetName = Replace(SourceSheetName, "'", "") ' Remove 's from sheet name
'
strSQL = "SELECT Count(*) FROM [" & SourceSheetName & "$]"
objRecordSet.Open Source:=strSQL, ActiveConnection:=objConnection, CursorType:=adOpenForwardOnly, Options:=adCmdText
SourceLastRow = objRecordSet(0) + 1 ' Save Last row number
'
SourceFullRange = "A1:E" & SourceLastRow ' Set the range of values from source file that we want to put into array
'
Set objRecordSet = objConnection.Execute("[" & SourceFullRange & "]")
On Error GoTo 0 ' Turn off error handling
'
SourceWorkbookArray = objRecordSet.GetRows ' returns a two dimensional array with all values in objRecordSet range
'
'--------------------------------------------------------------------------------------
'
For Each SourceRange In SourceRangesArray ' Load all Source range values to array list
SourceRowOffsetCounter = 0 ' Reset SourceRowOffsetCounter
'
ThisRangeLoopLength = Range(SourceRange).Cells.Count ' Get number of cells in range
FirstPartThisRange = Left(SourceRange, InStr(SourceRange, ":") - 1) ' Get first half of range
'
FirstPartRangeRowNumber = Range(FirstPartThisRange).Row ' Get row number from first part of range
FirstPartRangeColumnLetter = Split(Cells(1, Range(FirstPartThisRange).Column).Address, "$")(1) ' Get column letter from first part of range
FirstPartRangeColumnNumber = Range(FirstPartRangeColumnLetter & 1).Column ' Convert the Column letter to a column number
'
For ThisRangeLoopCounter = 1 To ThisRangeLoopLength ' Loop through this range
RowArrayList.Add SourceWorkbookArray(FirstPartRangeColumnNumber - 1, FirstPartRangeRowNumber - 2 + SourceRowOffsetCounter) ' Add value to array list
SourceRowOffsetCounter = SourceRowOffsetCounter + 1 ' Increment SourceRowOffsetCounter
Next
Next
'
WS.Range(ResultColumnLetter & FileNameRow).Resize(1, RowArrayList.Count).Value = RowArrayList.ToArray ' Display contents of array list to row
RowArrayList.Clear ' Clear all items from the array list
Else
WS.Range(ResultColumnLetter & FileNameRow) = FileNotFoundMessage ' Indicate file not found
End If
Next
'
'--------------------------------------------------------------------------------------
'
' Turn Settings back on
Application.EnableEvents = True ' Turn EnableEvents back on
Application.Calculation = xlCalculationAutomatic ' Turn AutoCalculation back on
Application.ScreenUpdating = True ' Turn Screen Updating back on
'
MsgBox "Done."
'
Exit Sub
'
InvalidInput:
MsgBox "The FullFilePathNameExtention or source range is invalid!", vbExclamation, "Get data from closed workbook" ' Inform user that an error occurred
Set objRecordSet = Nothing ' Delete Object
Set objConnection = Nothing ' Delete Object
'
' Turn Settings back on
Application.EnableEvents = True ' Turn EnableEvents back on
Application.Calculation = xlCalculationAutomatic ' Turn AutoCalculation back on
Application.ScreenUpdating = True ' Turn Screen Updating back on
End Sub

This also work perfect, except is inserting "FNF" only in the first column:

Screenshot 2021-10-05 105233.png
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,849
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Not sure why you need it displayed more than once per row, but you can replace:

VBA Code:
            WS.Range(ResultColumnLetter & FileNameRow).Resize(1, RowArrayList.Count).Value = RowArrayList.ToArray   ' Display contents of array list to row
            RowArrayList.Clear                                                                                      ' Clear all items from the array list
       Else
           WS.Range(ResultColumnLetter & FileNameRow) = FileNotFoundMessage                                        ' Indicate file not found

with:

VBA Code:
            WS.Range(ResultColumnLetter & FileNameRow).Resize(1, RowArrayList.Count).Value = RowArrayList.ToArray   ' Display contents of array list to row
            ArraySize = RowArrayList.Count
            RowArrayList.Clear                                                                                      ' Clear all items from the array list
        Else
            WS.Range(ResultColumnLetter & FileNameRow).Resize(1, ArraySize).Value = FileNotFoundMessage             ' Indicate file not found
 

TBIALEK

New Member
Joined
Mar 18, 2016
Messages
24
Like always work great, thanks - much faster then 12 macros...
Is there a way to "skip" a column if I need to do some calculations ? For example - fill columns "F" and "G" skip "H" ? (Fill "I" and "J" skip "K )


Screenshot 2021-10-06 071818.png
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,849
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
How about:

VBA Code:
Sub GetRangeFromClosedWorkbookV7()                                      '  *** Copy data across row *** Check for missing files *** Adds data to table
'
' This file can do single address range as well as multiple cell address ranges
' This file assumes all ranges to be vertical 1D ranges
'
'
'   Turn Settings off
      Application.ScreenUpdating = False                                    ' Turn Screen Updating off
         Application.Calculation = xlCalculationManual                      ' Turn AutoCalculation off
        Application.EnableEvents = False                                    ' Turn EnableEvents off
'
    Dim FileNameRow As Long, FirstPartRangeColumnNumber As Long, FirstPartRangeRowNumber As Long, SourceRowOffsetCounter As Long
    Dim SourceLastRow  As Long, ThisRangeLoopLength As Long, ThisRangeLoopCounter As Long, SourceRangeLoop As Long
'
    Dim objCatalog As Object, objConnection As Object, objRecordSet As Object
'
    Dim FileExtention As String, FileNotFoundMessage As String, FirstPartThisRange As String, FirstPartRangeColumnLetter As String
    Dim FullFilePathNameExtention As String, ResultColumnLetter As String, SourceDirectory As String, SourceFileAddressColumn As String
    Dim SourceFileAddressRow As String, SourceFileName As String, SourceFullRange As String, SourceSheet As String
    Dim SourceSheetName As String, strConnect As String, strSQL As String
'
    Dim SourceRange As Variant, SourceRangesArray As Variant, SourceWorkbookArray As Variant
'
    Dim WS As Worksheet
'
'--------------------------------------------------------------------------------------
'
    Set WS = Sheets("Sheet1")                                                   ' <--- Set this to the sheet name used to store values from the closed workbook
    SourceFileAddressColumn = "F"                                               ' <--- Set this to the column used for Source File Names
    SourceFileAddressRow = "3"                                                  ' <--- Set this to the start row number used for Source File Names
    ResultColumnLetter = "H"                                                    ' <--- Set the column to store results in
    SourceDirectory = "C:\Test\Data\"                                               ' <--- Set this to the directory of the closed workbooks
    FileExtention = ".xlsx"                                                     ' <--- Set this to the file extention of the closed workbook(s) ie. .xlsx
    FileNotFoundMessage = "FNF"                                                 ' <--- set this to cell value indicating file not found
'
'   Add/Remove as many ranges that you want
    SourceRangesArray = Array("B2:B2", "B3:B3", "C5:C10", "C15:C20")            ' <--- Set this to the ranges in the closed workbook to get data from
'
'--------------------------------------------------------------------------------------
'
    For FileNameRow = SourceFileAddressRow To WS.Range(SourceFileAddressColumn & SourceFileAddressRow).End(xlDown).Row  ' Range of file names to loop through
        SourceFileName = WS.Range(SourceFileAddressColumn & FileNameRow)        '   Set Address to use for the file name of closed workbook
'
        FullFilePathNameExtention = SourceDirectory & SourceFileName & FileExtention    ' FullFilePathNameExtention
'
        If Dir(SourceDirectory & SourceFileName & FileExtention) <> "" Then     '   If file name exists then ...
            Set objCatalog = CreateObject("ADOX.Catalog")                       '       Set up catalog so we can get the sheet name
            Set objConnection = CreateObject("ADODB.Connection")                '       Set up connection so we can connect to the source file
            Set objRecordSet = CreateObject("ADODB.Recordset")                  '       Set up recordset so we can get the Last row and range values
'
            strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FullFilePathNameExtention & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
'
            On Error GoTo InvalidInput                                          '       If an error is encountered, goto the error handling section
            objConnection.Open strConnect                                       '       open the connection to the source file
'
            objCatalog.ActiveConnection = objConnection
            SourceSheetName = Replace(objCatalog.Tables(0).Name, "$", "")       '       Remove $ from end of sheet name
            SourceSheetName = Replace(SourceSheetName, "'", "")                 '       Remove 's from sheet name
'
            strSQL = "SELECT Count(*) FROM [" & SourceSheetName & "$]"
            objRecordSet.Open Source:=strSQL, ActiveConnection:=objConnection, CursorType:=adOpenForwardOnly, Options:=adCmdText
            SourceLastRow = objRecordSet(0) + 1                                 '       Save Last row number
'
            SourceFullRange = "A1:E" & SourceLastRow                            '       Set the range of values from source file that we want to put into array
'
            Set objRecordSet = objConnection.Execute("[" & SourceFullRange & "]")
            On Error GoTo 0                                                     '       Turn off error handling
'
            SourceWorkbookArray = objRecordSet.GetRows                          '       returns a two dimensional array with all values in objRecordSet range
'
'--------------------------------------------------------------------------------------
'
            ColumnIncrementer = 0
            ColumnSkipCheck = 0
'
            For Each SourceRange In SourceRangesArray                                                           ' Load all Source range values to array list
                SourceRowOffsetCounter = 0                                                                      ' Reset SourceRowOffsetCounter
'
                ThisRangeLoopLength = Range(SourceRange).Cells.Count                                            ' Get number of cells in range
                FirstPartThisRange = Left(SourceRange, InStr(SourceRange, ":") - 1)                             ' Get first half of range
'
                FirstPartRangeRowNumber = Range(FirstPartThisRange).Row                                         ' Get row number from first part of range
                FirstPartRangeColumnLetter = Split(Cells(1, Range(FirstPartThisRange).Column).Address, "$")(1)  ' Get column letter from first part of range
                FirstPartRangeColumnNumber = Range(FirstPartRangeColumnLetter & 1).Column                       ' Convert the Column letter to a column number
'
                For ThisRangeLoopCounter = 1 To ThisRangeLoopLength                                             ' Loop through this range
                    WS.Range(ResultColumnLetter & FileNameRow).Offset(0, ColumnIncrementer).Value = SourceWorkbookArray(FirstPartRangeColumnNumber - 1, FirstPartRangeRowNumber - 2 + SourceRowOffsetCounter)   ' Display contents to row
                    SourceRowOffsetCounter = SourceRowOffsetCounter + 1                                             ' Increment SourceRowOffsetCounter
                    ColumnIncrementer = ColumnIncrementer + 1
                    ColumnSkipCheck = ColumnSkipCheck + 1
'
                    If ColumnSkipCheck = 2 Then
                        ColumnIncrementer = ColumnIncrementer + 1
                        ColumnSkipCheck = 0
                    End If
                Next
            Next
'
            RowSize = ColumnIncrementer - 1
        Else
            WS.Range(ResultColumnLetter & FileNameRow).Resize(1, RowSize).Value = FileNotFoundMessage             ' Indicate file not found
        End If
    Next
'
'--------------------------------------------------------------------------------------
'
'   Turn Settings back on
    Application.EnableEvents = True                                                                                 ' Turn EnableEvents back on
    Application.Calculation = xlCalculationAutomatic                                                                ' Turn AutoCalculation back on
    Application.ScreenUpdating = True                                                                               ' Turn Screen Updating back on
'
    MsgBox "Done."
'
    Exit Sub
'
InvalidInput:
    MsgBox "The FullFilePathNameExtention or source range is invalid!", vbExclamation, "Get data from closed workbook"  ' Inform user that an error occurred
     Set objRecordSet = Nothing                                                                                         ' Delete Object
    Set objConnection = Nothing                                                                                         ' Delete Object
'
'   Turn Settings back on
    Application.EnableEvents = True                                                                                     ' Turn EnableEvents back on
    Application.Calculation = xlCalculationAutomatic                                                                    ' Turn AutoCalculation back on
    Application.ScreenUpdating = True                                                                                   ' Turn Screen Updating back on
End Sub
 

TBIALEK

New Member
Joined
Mar 18, 2016
Messages
24
Nice, but is it possible to pick which column I want to skip ? Won`t be more then 2 or 3.
 

Forum statistics

Threads
1,148,170
Messages
5,745,166
Members
423,929
Latest member
z y

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top