Loop Through To Enter Data In Multiple Closed Workbooks

[Tristanfrontline]

Hi
I currently use a macro where I enter the location ofa bunch of workbooks and it automatically changes a specific cell to what I require. The code is -

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myrange As Range
    Dim Lastrow As Long
    Dim sFolder As String
    
    'folder where workbooks are stored
     'change as required (Ensure that the end of your link has the backslash otherwise code wont work)
    sFolder = "C:\\"
   
    Lastrow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row + 1
    If Lastrow < 4 Then Lastrow = 4
    Application.ScreenUpdating = False
    Set myrange = Me.Range("D13:D13" & Lastrow)
    If Not Intersect(Target, myrange) Is Nothing Then
        UpdateFilesInFolder Target, sFolder
    End If
    Application.ScreenUpdating = True
End Sub

Sub UpdateFilesInFolder(ByVal Target As Range, ByVal sFolder As String)
    Dim strFile As String
    
    strFile = Dir(sFolder & "*.xlsx", vbNormal)

    Do While strFile <> ""
        If strFile <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(sFolder & strFile, ReadOnly:=False)
        
        With wb
            .Worksheets("Total Quantities").Range(Target.Address).Value = Target.Value
            .Close True
        End With
        End If
        strFile = Dir
    Loop
End Sub

This works well but when I have sub folders it will not search through those folders and update any workbooks which are in those. I am also wanting to make it so instead of entering the location manually I would just click a button instead and browse the directory the excel workbooks are stored. What coding do I need to change so that it will work in the way I am describing. I hope this makes sense. Any help will be greatly appreciated

[Alf]

As far as I can see the sFolder line seems to be hard coded in the "Private Sub Worksheet_Change"

If you wish to be able browse and select a directory where the workbooks are stored you could test adding these lines to the "Private Sub"

Dim intResult As Integer

intResult = Application.FileDialog(msoFileDialogFolderPicker).Show

If intResult = 0 Then

    MsgBox "User pressed cancel macro will stop!"
    
    Exit Sub
    
Else

    sFolder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
    
End If

This will not search the sub folders but it could be added if this part of the code works i.e. selecting an abitrary folder and change the found files in that folder.

Alf

[Tristanfrontline]

Hi Alf
Thanks for that that works as you say it will but it isn't really helping in my dilemma. It's good that I can now select the folder rather than enter the location manually into the code but I really need it to loop through all files in all of the sub directories as a lot of my files are stored under sub directories. I have a code that works opposite where I pull data from all of the closed work books in my sub directories I just cant figure out how to make it work the other way by entering data into all of the closed work books of the sub directories. Thanks for your help

[Alf]

So since the first part worked I'll give you a code snippet for looping through sub foders. You I'll have to modify the variables according to what you use.

Sub OpenSubfoldersFileUpdate()
 Dim strFile As String
 Dim objFSO
 Dim mainFolder, mySubFolder 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 mFolder = sFolder
 Set mainFolder = objFSO.GetFolder(mFolder)
 Application.ScreenUpdating = False
 For Each mySubFolder In mainFolder.subfolders
 strFile = Dir(mySubFolder & "\*.xls*")
 Do While strFile <> ""
    Workbooks.Open mySubFolder & "\" & strFile
‘ Your code here

    strFile = Dir
 Loop
 Next ‘ subfolder
 Application.ScreenUpdating = True
 End Sub

Alf

[Tristanfrontline]

Hi Alf
Thanks for that I have tried it a few times to no avail. It seems the

Next ‘ subfolder

is causing issues. I have tried doing different things but come up with a whole range of different errors.
my code looks like this at the moment

Sub OpenSubfoldersFileUpdate()
 Dim strFile As String
 Dim objFSO
 Dim mainFolder, mySubFolder
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 mFolder = sFolder
 Set mainFolder = objFSO.GetFolder(mFolder)
 Application.ScreenUpdating = False
 For Each mySubFolder In mainFolder.subfolders
 strFile = Dir(mySubFolder & "\*.xls*")
 Do While strFile <> ""
    Workbooks.Open mySubFolder & "\" & strFile
    
 Lastrow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row + 1
    If Lastrow < 4 Then Lastrow = 4
    Application.ScreenUpdating = False
    Set myrange = Me.Range("D13:D13" & Lastrow)
    If Not Intersect(Target, myrange) Is Nothing Then
        UpdateFilesInFolder Target, sFolder
       End If
    Application.ScreenUpdating = True
   strFile = Dir
 Loop
 Next ‘ subfolder
 Application.ScreenUpdating = True
 End Sub



Sub UpdateFilesInFolder(ByVal Target As Range, ByVal sFolder As String)
    Dim strFile As String
    
    strFile = Dir(sFolder & "*.xlsx", vbNormal)

    Do While strFile <> ""
        If strFile <> ThisWorkbook.Name Then
        Set Wb = Workbooks.Open(sFolder & strFile, ReadOnly:=False)
        
        With Wb
            .Worksheets("Total Quantities").Range(Target.Address).Value = Target.Value
            .Close True
        End With
        End If
        strFile = Dir
    Loop
End Sub

I have left it the way you initially wrote it and it highlights that Next ' subfolder line in red indicating an issue. I have removed the apostrophe and tried different lines and altered the code above and below it to try and get it to work but it just keeps kicking back errors.

[Alf]

The line

For Each mySubFolder In mainFolder.subfolders

requires a

Next

statement. The apostrophe cancels out what come next and is used for the comments you add to the code in this case telling that the "Next" refers to the next subdirectory.

Under the main subdirectory do you have more ore only 1 subdirectory?

Alf

[Tristanfrontline]

I can have several sub directories it depends on what I am doing. I will have at least 2 sub directories generally. It highlighted it as red and not green like it normally would if you commented it out. I understand that for it to be commented out you put the apostrophe at the start I am a little confused as to what to put there. Do I repeat my code down into that? Isn't that what the loop is for until it reaches the end of the excel files in the all of the directories and sub directories? Maybe I have misunderstood how it works

[Alf]

This code loops through all files in the folder you selct and if there are sub folder "under" the main folder it also loops through all those files as well.

At the moment this code opends every file and writes a value to cell B2. To make it simple I alo assume there is only one sheet in every file.

 Sub FindFileInFolds()
Dim intResult As Integer
Dim strPath As String
Dim strFile As String
Dim mFolder As String
Dim objFSO
Dim mainFolder, mySubFolder

 Application.ScreenUpdating = False

intResult = Application.FileDialog(msoFileDialogFolderPicker).Show

If intResult = -1 Then

strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"

End If

Set objFSO = CreateObject("Scripting.FileSystemObject")

mFolder = strPath

strFile = Dir(strPath & "*.xls*")

Do While strFile <> ""
    Workbooks.Open strPath & strFile
    Range("B2") = "Yepp"
    ActiveWorkbook.Close True
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = strPath & strFile
    strFile = Dir
 Loop

Set mainFolder = objFSO.GetFolder(mFolder)

For Each mySubFolder In mainFolder.subfolders

strFile = Dir(mySubFolder & "\*.xls*")
 Do While strFile <> ""
    Workbooks.Open mySubFolder & "\" & strFile
    Range("B2") = "Yepp"
    ActiveWorkbook.Close True
    strFile = Dir
 Loop

Next

 Application.ScreenUpdating = True
 
End Sub

See this model as an example of how to loop through folders and subfolder and add (or exctract) data from workbooks. If the workbooks contain several sheets then one need a loop to activate every sheet or one can atctivate a speciffic sheet.

Modifying you excistent including the loop what is not a job I'll undertake as I'm not sure I do understand how it works.

Alf

[Tristanfrontline]

Hi Alf
Thanks for that your code doesn't work exactly as you say it does it only enters data in the current open workbook in cell b2 and pulls the file path from each of the files in the other folders and inserts that file path in the currently open workbook. I am trying to set the loop up with my cod but I keep getting errors usually Loop without Do. I have the do while command in before my code to run but it still isn't working.
This is how my code is currently looking

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myrange As Range
    Dim Lastrow As Long
    Dim strPath As String
    Dim objFSO
    Dim mainFolder, mySubFolder
    
    Application.ScreenUpdating = False

intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
If intResult = -1 Then

strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"

End If
Set objFSO = CreateObject("Scripting.FileSystemObject")

mFolder = strPath


strFile = Dir(strPath & "*.xls*")
   Do While strFile <> ""
    Lastrow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row + 1
    If Lastrow < 4 Then Lastrow = 4
    Application.ScreenUpdating = False
    Set myrange = Me.Range("D13:D13" & Lastrow)
    If Not Intersect(Target, myrange) Is Nothing Then
        UpdateFilesInFolder Target, sFolder
        Loop
       Next
    Application.ScreenUpdating = True
End Sub

Sub UpdateFilesInFolder(ByVal Target As Range, ByVal sFolder As String)
    Dim strFile As String
    
    strFile = Dir(sFolder & "*.xlsx", vbNormal)

    Do While strFile <> ""
        If strFile <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(sFolder & strFile, ReadOnly:=False)
        
        With wb
            .Worksheets("Total Quantities").Range(Target.Address).Value = Target.Value
            .Close True
        End With
        End If
        strFile = Dir
    Loop
End Sub

Now I am not sure where I have stuffed it up but it just isn't working. All I need to do is enter the data on cell D13 in the sheets titled "Total Quantities". The other code does this but having to enter the directory is painful and slow hence the reason why I want it to loop through all of the sub directories of folder I select and apply it to all of my closed excel workbooks

[Alf]

Yes the macro I wrote loops through all files in a folder and the subfolders, opens each file write a value to it and closes the file before moving on to the next.

The macro you have work in the same way. The “Private Sub” set up some parameters in the “Master” file and then starts the “Sub UpdateFilesInFolder”. This macro loops through all files in folder and “lo and behold” opens them, make a change and closes the file before moving on to next.

Set wb = Workbooks.Open(sFolder & strFile, ReadOnly:=False)
        With wb
            .Worksheets("Total Quantities").Range(Target.Address).Value = Target.Value
            .Close True

Well I hope you solve your problem.

Alf