VBA - dynamic data import when having the folder path in a cell

[Pelle Peloton]

Hi! I'm beginner with VBA and struggling to get dynamic "data import" to work properly in a way that the path is taken from a cell value (instead of written to VBA code). I have one master Excel (sheet "WP_Data") to which I want to import data (one cell content) from tens of source-Excels (in each of them I have sheet "Workpaper_main" and a cell that is named as "WP_balance").

The below macro works, but the issue is that I have the "C:\Users\UsernameABC\XXX\2021-Jan\" written in the code. If some other user wants to import data with this macro --> "UsernameABC" in the path will change. Or when I want to search eg. 2021-Feb data -> I need to update the path as well. I have tried a few different ways to get the path taken from a cell in my Master-Excel (sheet "Parameters", cell "D3"), but haven't succeeded and I understood it might be related to Const - when trying to get strPath to be Range("D3").value. In the Excel I have a few parameters the user can update and that gives the proper path to cell D3.

Any advise highly appreciated!

Sub import_data()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = thisWorkbook
    Dim LastRow As Long
    
    'empty old data on "WP_Data" sheet
    wkbDest.Sheets("WP_Data").Activate
    Columns("A:B").Select
    Selection.ClearContents
    Range("A1").Select
   
    'Search the data from all Excels
    Const strPath As String = "C:\Users\UsernameABC\XXX\2021-Jan\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
        .Sheets("Workpaper_main").Range("WP_balance").Copy
       
    'copy the figures from workpapers and paste to this Master-Excel
        wkbDest.Sheets("WP_Data").Cells(wkbDest.Sheets("WP_Data").Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
       
     'copy the workpaper names from workpapers and paste to this Master-Excel
       wkbDest.Sheets("WP_Data").Activate
       fRow = wkbDest.Sheets("WP_Data").Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Offset(0, 0).Row
       lrow = wkbDest.Sheets("WP_Data").Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Row
       wkbDest.Sheets("WP_Data").Range("A" & fRow) = wkbSource.Name
    
        .Close savechanges:=False
                     
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
If you are putting the full file path in D3 then change this

Const strPath As String = "C:\Users\UsernameABC\XXX\2021-Jan\"

to

Dim strPath As String
strPath = wkbDest.Sheets("Parameters").Range("D3").Value

 

[Pelle Peloton]

Hi & welcome to MrExcel.
If you are putting the full file path in D3 then change this

Const strPath As String = "C:\Users\UsernameABC\XXX\2021-Jan\"

to

Dim strPath As String
strPath = wkbDest.Sheets("Parameters").Range("D3").Value

Thank you Fluff, great! I got the original VBA code working and imports the data nicely!

I noticed I need to still improve my code a bit. In some of my source Excels there is also another named cell "WB_balance2" that I want to import as well. I added the below code to the same sub and it works to import also the value from cell named "WB_balance2" and also imports the workpaper name (and adds "2" at the end). However, this works only when there is a cel "WP_Balance2" in all source Excels. I couldn't get working properly any IfError or On Error for the case when there is no cell named "WP_balance2". In those cases the below code should do nothing. Are you able to assist this as well; which command I should add and which part of the code?

Dim str2Path As String
str2Path = wkbDest.Sheets("Parameters").Range("D3").Value

ChDir str2Path
strExtension = Dir("*.xls*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource

.Sheets("Workpaper_main").Range("WP_balance2").Copy

'copy the figures from workpapers and paste to this Master-Excel
wkbDest.Sheets("WP_Data").Cells(wkbDest.Sheets("WP_Data").Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

'copy the workpaper names from workpapers and paste to this Master-Excel
wkbDest.Sheets("WP_Data").Activate
fRow = wkbDest.Sheets("WP_Data").Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Offset(0, 0).Row
lrow = wkbDest.Sheets("WP_Data").Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Row
wkbDest.Sheets("WP_Data").Range("A" & fRow) = wkbSource.Name & "2"

.Close savechanges:=False

End With
strExtension = Dir
Loop

Application.ScreenUpdating = True
End Sub

 

[Fluff]

As this is now a substantially different question, it needs a new thread. Thanks