Importing data from multiple closed workbooks based on variable defined path

user_7040233 0
Viewed 75

I have hit a wall in trying to find a solution to my problem. Here is a summary of what I am trying to do:

Situation: I receive 4 identical worksheets weekly and I need to combine data on my summary worksheet:

Year Week Town 1 Town 2 Town 3 Town 4
2021 Week 1
2021 Week 2

Worksheets: I receive identical worksheets weekly with paths to the cell I need to pull looking like this:

A:\Network\2021\Week 1[Town 1.xlsx]Sheet1'!$D$4'

A:\Network\2021\Week 1[Town 2.xlsx]Sheet1'!$D$4'

A:\Network\2021\Week 1[Town 3.xlsx]Sheet1'!$D$4'

A:\Network\2021\Week 1[Town 4.xlsx]Sheet1'!$D$4'

Idea/Solution:

User wants to populate data from Week 1:

  1. User is prompted with InputBox to enter Year and Week which will become variables in a file path to pull data

  2. Inputs would create file path: A:\Network\ Year Input \ Week Input \ [Header.xlsx]Sheet1'!$D$4'

  3. Then using that input pull the data from each workbook

Where I'm at now:

From my research it seems that I would have to use vba to achieve this but i'm not an expert, would you happen to know a simpler method or let me know if I'm on the right track with my code?

Sub AddANewWeek ()
    ' ------------- Town Summary Worksheet -------------
    
    Application.ScreenUpdating = False
    
    Worksheets("Town Summary").Activate
    
    Dim Town_Summary As Worksheet
    Set Town_Summary = Worksheets("Town Summary")
    
    '------------- User inputs the name of the Year-Week to extract the data -------------
    
    On Error GoTo ErrorMessage
    
    Dim myYear As Variant
    myYear = InputBox("Please enter the Year to extract data:")

    On Error GoTo ErrorMessage
    
    Dim myWeek As Variant
    myWeek = InputBox("Please enter the Week to extract data:")
xlsm xlsx vba excel
2 Answers

enter image description here

Make the necessary changes in the CONFIG area of the code before you try it.

Sub add_new_week()

Dim path As String, root_path As String
Dim town_data As String, slash As String
Dim year As Long, next_col As Long, N As Long, week_number As Long
Dim town1_col As Integer, town1_row As Integer, next_row As Integer
Dim input_range As Range
Dim source_wb As Workbook, main_wb As Workbook

Set main_wb = ActiveWorkbook

'CONFIG
'---------------------------------
root_path = "A:\Network\"
town_data = "D4" 'set the range for the source data
town1_col = 4    'set the COLUMN number for Town 1 in Town Summary sheet
town1_row = 5    'set the ROW number for Town 1 in Town Summary sheet
'---------------------------------

Set input_range = _
Application.InputBox("Where would you like to start pasting the data?", Type:=8)

week_number = InputBox("Please enter the WEEK NUMBER to extract data")

next_row = input_range.Row
next_col = input_range.Column

'Windows and Mac compatibility
slash = Application.PathSeparator

'if is december or january input the year
If format$(Date, "mmmm") = "December" Or format$(Date, "mmmm") = "January" Then
    year = InputBox("Please enter the YEAR to extract data")
    Else: year = format$(Date, "yyyy")
End If

For N = 1 To 4
   
    On Error GoTo ErrMsg
    path = _
    root_path & year & slash & "Week " & week_number & slash & _
    main_wb.Sheets("Town Summary").Cells(town1_row, town1_col) & ".xlsx"
    
    If file_exists(path) = True Then
    
        Set source_wb = Application.Workbooks.Open(path)
        
        source_wb.Sheets("Sheet1").Range(town_data).Copy
        main_wb.Sheets("Town Summary").Cells(next_row, next_col).PasteSpecial
        
        source_wb.Close

    End If

    next_col = next_col + 1
    town1_col = town1_col + 1

Next

format_table

main_wb.Sheets("Town Summary").Range("A1").Select

Exit Sub

ErrMsg:
MsgBox ("Please enter a valid number."), , "Week number not found"

End Sub

Function file_exists(path As String) As Boolean

Dim test As String

    test = ""

    On Error Resume Next
    test = Dir(path)
    On Error GoTo 0
    If test = "" Then
        file_exists = False
    Else
        file_exists = True
    End If
    
End Function

Sub format_table()

    Cells.Select
    With Selection
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.InsertIndent 1
    With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.RowHeight = 22
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub
user_148959850

This can easily be done without VBA, using Power Query (Get & Transform). The whole solution is a bit much for one answer, but here are some starting points.

The user can enter the parameter into a worksheet cell. A formula can pick up that entry and generate a file path.

Power Query can read the file path and load all files in that folder for further processing.

There are many free resources online about Power Query in Excel. This one is about parameters

https://exceloffthegrid.com/power-query-using-parameters/

and this one about importing all files in a folder

https://exceloffthegrid.com/power-query-import-all-files-in-a-folder/

user_4479700
Related