Macro to Update a common value in all excel files in a folder including sub folders

RPM1979

New Member
Joined
Jul 8, 2016
Messages
15
Hi Friends,

I need to update a common value i.e. "123456" in Cell H1 of Worksheet name "Index" of all excel files which are stored in a folder. The folder also has sub folders.

I tried using below macro, however it is not updating files in folder and sub folder


Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean


'Fill in the path\folder where the files are
MyPath = "C:\User"


'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "" Then
MyPath = MyPath & ""
End If


'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If


'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop


'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With


'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0


If Not mybook Is Nothing Then




'Change cell value(s) in one worksheet in mybook
On Error Resume Next
With mybook.Worksheets(1)
If .ProtectContents = False Then


For Each sh In mybook.Worksheets
If LCase(Left(sh.Name, 5)) = "Index" Then


.Range("H1").Value = "123456"
Else
ErrorYes = True
End If
End If
End With




If Err.Number > 0 Then
ErrorYes = True
Err.Clear
'Close mybook without saving
mybook.Close savechanges:=False
Else
'Save and close mybook
mybook.Close savechanges:=True
End If
On Error GoTo 0
Else
'Not possible to open the workbook
ErrorYes = True
End If


Next Fnum
End If


If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If


'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub


Please assist me with changes in the above macro to update all files in folder and sub folders
 

Some videos you may like

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,619
When looping through files, folders and subfolders (a recursive loop), it's much easier to use FileSystemObject rather than Dir and creating arrays.

Try this on a copy of your main folder:

Code:
Public Sub Update_Cell_All_Workbooks_All_Folders()
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Process_Workbooks_In_Folder "C:\User - Copy"
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Done"
    
End Sub


Private Sub Process_Workbooks_In_Folder(folderPath As String)
   
    Static FSO As Object
    Dim Folder As Object, Subfolder As Object, File As Object
    Dim wb As Workbook
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'Process files in this folder
    
    Set Folder = FSO.GetFolder(folderPath)
    
    For Each File In Folder.Files
        If File.Name Like "*.xls*" Then
            Set wb = Workbooks.Open(File.Path)
            On Error Resume Next  'in case Index sheet doesn't exist
            wb.Worksheets("Index").Range("H1").Value = "123456"
            On Error GoTo 0
            wb.Close saveChanges:=True
        End If
    Next
    
    'Process files in subfolders
    
    For Each Subfolder In Folder.SubFolders
        Process_Workbooks_In_Folder Subfolder.Path
    Next

End Sub
 

RPM1979

New Member
Joined
Jul 8, 2016
Messages
15
Thanks John for the revised Macro. It is working beautifully without any error.

1 last assistance I need from you is can you modify the above macro to allow the users for selecting folder of their choice in their laptops. Right now we have hardcoded the macro to a particular folder only i.e. "C:\User - Copy"

Assistance on above will be of immense help since we have a team of around 20 people who need to use the said macros again and again on different folders.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,619
Replace the main procedure with:
Code:
Public Sub Update_Cell_All_Workbooks_All_Folders()
    
    Dim mainFolder As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the main folder"
        If Not .Show Then Exit Sub
        mainFolder = .SelectedItems(1)
    End With
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Process_Workbooks_In_Folder mainFolder
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Done"
   
End Sub
 

RPM1979

New Member
Joined
Jul 8, 2016
Messages
15
Thanks John. I am now able to select the folder of my choice. I have given users an option to provide the value they want to update in each as per below macro, however the macro is not picking the value inputted by users.

Please assist in rectification of error in below macro, I have made changes in the macro provided by you in red font below so that it is easy for you to refer

Kindly advise on same


Code:
Public Sub Update_Cell_All_Workbooks_All_Folders()
   [COLOR=#ff0000]
    Dim myValue1 As Variant
    myValue1 = InputBox("Enter Number")

    Dim myValue2 As Variant
    myValue2 = InputBox("Enter Name")[/COLOR]
   
    Dim mainFolder As String
   
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the main folder"
        If Not .Show Then Exit Sub
        mainFolder = .SelectedItems(1)
    End With
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Process_Workbooks_In_Folder mainFolder
   
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
    MsgBox "Done"
  
End Sub
 
Private Sub Process_Workbooks_In_Folder(folderPath As String)
  
[COLOR=#ff0000]    Dim myValue1 As Variant
[/COLOR][COLOR=#FF0000]    Dim myValue2 As Variant[/COLOR]
    Static FSO As Object
    Dim Folder As Object, Subfolder As Object, File As Object
    Dim wb As Workbook
   
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
   
    'Process files in this folder
   
    Set Folder = FSO.GetFolder(folderPath)
  
    For Each File In Folder.Files
        If File.Name Like "*.xls*" Then
            Set wb = Workbooks.Open(File.Path)
            On Error Resume Next  'in case Index sheet doesn't exist
            wb.Worksheets("Index").Range("H1").Value = [COLOR=#ff0000]myValue1[/COLOR]
            [COLOR=#ff0000]wb.Worksheets("Index").Range("H2").Value = myValue2
[/COLOR]            On Error GoTo 0
            wb.Close saveChanges:=True
        End If
    Next
   
    'Process files in subfolders
   
    For Each Subfolder In Folder.SubFolders
        Process_Workbooks_In_Folder Subfolder.Path
    Next
 
End Sub
 
Last edited by a moderator:

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,619
.... however the macro is not picking the value inputted by users.
Because myValue1 and myValue2 in Process_Workbooks_In_Folder are not the same variables as those variable names in Update_Cell_All_Workbooks_All_Folders. Every variable declared (Dim'ed) in a Sub or Function is local to that procedure and the procedure knows nothing about other local variables, even with the same name.

The simple solution is to move the first pair of red Dim's above the Public Sub Update_Cell_All_Workbooks_All_Folders() line and delete the second pair of red Dim's, and then the two variables can be seen by both procedures.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,850
Messages
5,598,457
Members
414,239
Latest member
xnanx

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