Get data from dynamic location and filename on closed workbook using VBA

J

Joe006

New Member
Joined
Nov 20, 2023
Messages
23
Office Version
  1. 2016
Platform
  1. Windows
1700555158018.png


Hi, I got a lot of excel files in different location where each files is put in folder named month and year. I need to get the data from it while it's closed and data is pulled based on the drop down list for the month and the year. I have tried using the INDIRECT function and it work only when the file is opened. I just discovered that need to use VBA script to pull while it closed, if using VBA, how to call the data and set formula for the folder name and file dynamically according the chosen drop down list ?

Any helps much appreciated, Thank you
 
Sort by date Sort by votes
eiloken said:
to clearly, i want to confirm that E2 equals with sum of all F6 values in input data files and B6 to E6 equals with values of C12 to F12 in file that named as "90XX SMod.xlsx". Is that true?
Click to expand...
Yes true. E5 is the sum all F6 not E2
 
Upvote 0

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Joe006 said:
Yes true. E5 is the sum all F6 not E2
Click to expand...
try this:
VBA Code: 
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("E5").Value = Empty
        pFol = "D:\OT Management" 'change it to your OT Management path"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders 'loop through each folder in your parent folder to find match folder with month and year
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then 'open each excel file and recalculate summary worksheet
                        Set wb = Workbooks.Open(filPath)
                        .Range("E5").Value = .Range("E5").Value + wb.Sheets("Summary").Range("F6").Value 'sum F6 in all input files
                        If wb.Name Like "90## SMod.xlsx" Then 'check that input file named as Smod
                            For i = 0 To 3
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            Next i
                        End If
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
eiloken said:
try this:
VBA Code: 
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("E5").Value = Empty
        pFol = "D:\OT Management" 'change it to your OT Management path"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders 'loop through each folder in your parent folder to find match folder with month and year
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then 'open each excel file and recalculate summary worksheet
                        Set wb = Workbooks.Open(filPath)
                        .Range("E5").Value = .Range("E5").Value + wb.Sheets("Summary").Range("F6").Value 'sum F6 in all input files
                        If wb.Name Like "90## SMod.xlsx" Then 'check that input file named as Smod
                            For i = 0 To 3
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            Next i
                        End If
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Click to expand...
1700702800083.png


Hi thanks for your help, the code works , just each time the workbook opened need to click either update and dont update to make it closes. Currently, i'm trying to figuring out on how make it run automatically or trigger it by button
 
Upvote 0
I'm trying to modify this line code to also loop and to pull data and calculate to the cell B5 to E5, is this code correct?:
VBA Code: 
 For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then 'open each excel file and recalculate summary worksheet
                        Set wb = Workbooks.Open(filPath)
                        
                        For i = 0 To 3
                                .Range("B5").Offset(, i).Value wb.Sheets("Summary").Range("C6").Offset(, i).Value
                            Next i
                            
                        .Range("E5").Value = .Range("E5").Value + wb.Sheets("Summary").Range("F6").Value 'sum F6 in all input files
                        
                        
                        If wb.Name Like "9023 SMold.xlsx" Then 'check that input file named as Smod
                            For i = 0 To 3
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            Next i
                        End If
                        wb.Close (False)
                    End If
1700704344341.png
 
Upvote 0
Joe006 said:
View attachment 102344

Hi thanks for your help, the code works , just each time the workbook opened need to click either update and dont update to make it closes. Currently, i'm trying to figuring out on how make it run automatically or trigger it by button
Click to expand...
try to change this code:
VBA Code: 
Set wb = Workbooks.Open(filPath, 0)
with 0 is not update link
 
Upvote 0
Joe006 said:
I'm trying to modify this line code to also loop and to pull data and calculate to the cell B5 to E5, is this code correct?:
VBA Code: 
 For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then 'open each excel file and recalculate summary worksheet
                        Set wb = Workbooks.Open(filPath)
                       
                        For i = 0 To 3
                                .Range("B5").Offset(, i).Value wb.Sheets("Summary").Range("C6").Offset(, i).Value
                            Next i
                           
                        .Range("E5").Value = .Range("E5").Value + wb.Sheets("Summary").Range("F6").Value 'sum F6 in all input files
                       
                       
                        If wb.Name Like "9023 SMold.xlsx" Then 'check that input file named as Smod
                            For i = 0 To 3
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            Next i
                        End If
                        wb.Close (False)
                    End If
View attachment 102346
Click to expand...
but E5 equals to sum of all input worksheets right?, if you change code like that, it only loop and get data in all input files and finish with data of last worksheet
 
Upvote 0
eiloken said:
but E5 equals to sum of all input worksheets right?, if you change code like that, it only loop and get data in all input files and finish with data of last worksheet
Click to expand...
oh sorry, actually B5 to E5 will sumup from all sheet, just it get data from different cells, B5 pull from C6, C5 pull from D6 and so on...
 
Upvote 0
Joe006 said:
oh sorry, actually B5 to E5 will sumup from all sheet, just it get data from different cells, B5 pull from C6, C5 pull from D6 and so on...
Click to expand...
try this:
VBA Code: 
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("B5:E5").Value = Empty 'change this to reset sum range
        pFol = "D:\OT Management"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then
                        Set wb = Workbooks.Open(filPath, 0) 'open with not update link
                        For i = 0 To 3
                            .Range("B5").Offset(, i).Value = .Range("B5").Offset(, i).Value + wb.Sheets("Summary").Range("C6").Offset(, i).Value 'change this to sum C6~F6
                            If wb.Name Like "90## SMod.xlsx" Then
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            End If
                        Next i
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Upvote 1
Solution
eiloken said:
try this:
VBA Code: 
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("B5:E5").Value = Empty 'change this to reset sum range
        pFol = "D:\OT Management"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then
                        Set wb = Workbooks.Open(filPath, 0) 'open with not update link
                        For i = 0 To 3
                            .Range("B5").Offset(, i).Value = .Range("B5").Offset(, i).Value + wb.Sheets("Summary").Range("C6").Offset(, i).Value 'change this to sum C6~F6
                            If wb.Name Like "90## SMod.xlsx" Then
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            End If
                        Next i
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Click to expand...
Thanks for your help, this works perfectly, now i working on the form button controls to start the code.
 
Upvote 0
eiloken said:
try this:
VBA Code: 
Private Sub GetFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pFol As String, xcode As String
    Dim fso As Object, fol As Object, subFol As Object, fil As Object
    Dim filPath As String
    Dim wb As Workbook
    Dim i As Integer
    With ThisWorkbook.Sheets(1)
        .Range("B5:E5").Value = Empty 'change this to reset sum range
        pFol = "D:\OT Management"
        xcode = Format(.Range("B2").Value, "00") & .Range("C2").Value
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fol = fso.GetFolder(pFol)
        For Each subFol In fol.SubFolders
            If subFol.Name = xcode Then
                For Each fil In subFol.Files
                    filPath = fso.GetAbsolutePathName(fil)
                    If filPath Like "*.xlsx" Then
                        Set wb = Workbooks.Open(filPath, 0) 'open with not update link
                        For i = 0 To 3
                            .Range("B5").Offset(, i).Value = .Range("B5").Offset(, i).Value + wb.Sheets("Summary").Range("C6").Offset(, i).Value 'change this to sum C6~F6
                            If wb.Name Like "90## SMod.xlsx" Then
                                .Range("B6").Offset(, i).Value = wb.Sheets("Summary").Range("C12").Offset(, i).Value
                            End If
                        Next i
                        wb.Close (False)
                    End If
                Next fil
            End If
        Next subFol
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Click to expand...

if I change (filPath, 1) this will update link right?

VBA Code: 
Set wb = Workbooks.Open(filPath, 1) 'open with not update link
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Automate data pull from one file to another
Replies
1
Views
191
John_w
J
N
  • Question
2-step Dynamic Ranges and Charts
Replies
0
Views
208
Nick Loughton
N
J
  • Question
Power Query - Data Refresh Error in Macro
Replies
3
Views
140
bobsan42
bobsan42
rehanahmad
  • Question
SUMIF With "Indirect" link to closed workbook
2
Replies
11
Views
457
RoryA
RoryA
R
  • Question
VBA to pull data from closed workbooks
Replies
3
Views
497
Logit
Logit

Forum statistics

Threads
1,215,077
Messages
6,122,991
Members
449,094
Latest member
masterms

Share this page

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
Back
Top