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

[RPM1979]

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

 

[John_w]

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:

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]

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]

Replace the main procedure with:

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]

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

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

 

[John_w]

.... 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.