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

Pelle Peloton

New Member
Joined
Nov 17, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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!

VBA Code:
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
 
Last edited by a moderator:

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,242
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
If you are putting the full file path in D3 then change this
VBA Code:
Const strPath As String = "C:\Users\UsernameABC\XXX\2021-Jan\"
to
VBA Code:
Dim strPath As String
strPath = wkbDest.Sheets("Parameters").Range("D3").Value
 
Solution

Pelle Peloton

New Member
Joined
Nov 17, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
If you are putting the full file path in D3 then change this
VBA Code:
Const strPath As String = "C:\Users\UsernameABC\XXX\2021-Jan\"
to
VBA Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,242
Office Version
  1. 365
Platform
  1. Windows
As this is now a substantially different question, it needs a new thread. Thanks
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,139
Messages
5,835,633
Members
430,372
Latest member
contentment

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