Macros for editing multiple workbooks

dilshod_k

Board Regular
Joined
Feb 13, 2018
Messages
79
I have a file called DataFile.xlsm, with Sheet1, and date recorded in A1 cell.
In the same directory I have number of other workbooks with date recorded on Sheet "Control", A1 cell.
I'm trying to write macros to loop through all files in the same directory (or directory C:\MOS\)
The aim is to change value in the cell A1, Sheet "Control" of each workbook to value equal to A1 cell, Sheet1 of DataFile.
Macros should run from DataFile. Would be grateful for any suggestions. Thanks in advance.
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Seems like this should work. HTH. Dave
Code:
Sub test()
Dim FSO As Object, FlDr As Object, Fl As Object
Dim sht As Worksheet
Set FSO = CreateObject("scripting.filesystemobject")
Set FlDr = FSO.GetFolder("C:\MOS\")
Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next
For Each Fl In FlDr.Files
If Fl.Name Like "*.xls*" Then
Workbooks.Open Filename:=Fl
For Each sht In Fl.Sheets
If sht.Name = "Control" Then
Workbooks(Fl.Name).Sheets("Control").Range("A" & 1) = _
            ThisWorkbook.Sheets("Sheet1").Range("A" & 1).Value
Exit For
End If
Next sht
Workbooks(Fl.Name).Close SaveChanges:=True
End If
Next Fl

Set FlDr = Nothing
Set FSO = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Upvote 0
Seems like this should work. HTH. Dave
Code:
Sub test()
Dim FSO As Object, FlDr As Object, Fl As Object
Dim sht As Worksheet
Set FSO = CreateObject("scripting.filesystemobject")
Set FlDr = FSO.GetFolder("C:\MOS\")
Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next
For Each Fl In FlDr.Files
If Fl.Name Like "*.xls*" Then
Workbooks.Open Filename:=Fl
For Each sht In Fl.Sheets
If sht.Name = "Control" Then
Workbooks(Fl.Name).Sheets("Control").Range("A" & 1) = _
            ThisWorkbook.Sheets("Sheet1").Range("A" & 1).Value
Exit For
End If
Next sht
Workbooks(Fl.Name).Close SaveChanges:=True
End If
Next Fl

Set FlDr = Nothing
Set FSO = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Thanks a lot for help.
How to exclude file DataFile.xlsm from the rest of the files. The macros is supposed to run from DataFile. When I run it it gives message that DataFile is already open and an attempt to open it again will not save any changes, and I found it out only after changing DisplayAlerts to True, otherwise it would run with no error messages but at the same time id does not make any changes to files in the directory specified. Thanks in advance for any suggestions.

Sub LoopThroughNdNovice()


Dim FSO As Object, FlDr As Object, Fl As Object
Dim sht As Worksheet
Set FSO = CreateObject("scripting.filesystemobject")
Set FlDr = FSO.GetFolder("C:\Users\User\Downloads\Trading\Test\Master DataFile")
Application.ScreenUpdating = True
Application.DisplayAlerts = True


On Error Resume Next
For Each Fl In FlDr.Files
If Fl.Name Like "*.xls*" Then
Workbooks.Open fileName:=Fl
For Each sht In Fl.Sheets
If sht.Name = "Control" Then
Workbooks(Fl.Name).Sheets("Control").Range("A" & 1) = _
ThisWorkbook.Sheets("Sheet1").Range("A" & 1).Value
Exit For
End If
Next sht
Workbooks(Fl.Name).Close SaveChanges:=True
End If
Next Fl


Set FlDr = Nothing
Set FSO = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Upvote 0
Yeah, already done that :stickouttounge:, the only difference I replaced it by simply changing to :

If Fl.Name <> "DataFile.xlsm" Then

Thanks a lot, much appreciate your help.
Now the code takes 16.71 sec to make changes to 11 files (with Application.ScreenUpdating = False and Application.DisplayAlerts = False) in my modification, and 16.41 sec in yours.
I was wandering is there any chance to reduce time as changing value just in one cell in each file is only part of the program, I want this code to open each file, change Date value in one cell and then run, lets say, "Macros 3" which in turn does lots of job: downloads historical price data, analyses data, selects some of it and then exports it to DataFile. To run Macros3 within each file already takes around 30 secs. Would be grateful to any suggestions. Regards. Dilshod.
 
Upvote 0
Code:
Sub test()
Dim FSO As Object, FlDr As Object, Fl As Object
Dim sht As Worksheet
Set FSO = CreateObject("scripting.filesystemobject")
Set FlDr = FSO.GetFolder("C:\MOS\")
Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next
For Each Fl In FlDr.Files
If Fl.Name Like "*.xls*" Then
If Fl.Name <> "DataFile.xlsm" Then
Workbooks.Open Filename:=Fl
For Each sht In Fl.Sheets
If sht.Name = "Control" Then
Workbooks(Fl.Name).Sheets("Control").Range("A" & 1) = _
            ThisWorkbook.Sheets("Sheet1").Range("A" & 1).Value
Exit For
End If
Next sht
Workbooks(Fl.Name).Close SaveChanges:=True
End If
End If
Next Fl

Set FlDr = Nothing
Set FSO = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Trial 2 . Dave
edit: I see that U resolved this. The time required is a function of opening, saving and then closing files. It shouldn't add too much additional time to do some more stuff once the file is opened. Just don't use copy and paste to transport more info back to your datafile. If U want to transport data from the files, load it into an array, process all of your files and then unload it all at once to your data file.
 
Last edited:
Upvote 0
Code:
Sub test()
Dim FSO As Object, FlDr As Object, Fl As Object
Dim sht As Worksheet
Set FSO = CreateObject("scripting.filesystemobject")
Set FlDr = FSO.GetFolder("C:\MOS\")
Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error Resume Next
For Each Fl In FlDr.Files
If Fl.Name Like "*.xls*" Then
If Fl.Name <> "DataFile.xlsm" Then
Workbooks.Open Filename:=Fl
For Each sht In Fl.Sheets
If sht.Name = "Control" Then
Workbooks(Fl.Name).Sheets("Control").Range("A" & 1) = _
            ThisWorkbook.Sheets("Sheet1").Range("A" & 1).Value
Exit For
End If
Next sht
Workbooks(Fl.Name).Close SaveChanges:=True
End If
End If
Next Fl

Set FlDr = Nothing
Set FSO = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Trial 2 . Dave
edit: I see that U resolved this. The time required is a function of opening, saving and then closing files. It shouldn't add too much additional time to do some more stuff once the file is opened. Just don't use copy and paste to transport more info back to your datafile. If U want to transport data from the files, load it into an array, process all of your files and then unload it all at once to your data file.

Thanks for suggestion Dave, Trial 2 took 17.59 sec (around 1 sec longer than Version 1) to change cell with date in 11 files. I did not make any changes to code except for file path. Thanks for trying to help anyway.
 
Upvote 0
Change If Fl.Name Like "*.xls*" Then to

If Fl.Name Like "*.xls*" and Fl.Name <> "DataFile.xlsm" Then

Yeah, already done that :stickouttounge:, the only difference I replaced it by simply changing to :

If Fl.Name <> "DataFile.xlsm" Then


Thanks a lot for help. Appreciate it.
 
Upvote 0
I'm guessing your using XL 2016 … it's slow. Trial using an earlier version of XL to reduce your wait time. HTH. Dave
 
Upvote 0
I'm guessing your using XL 2016 … it's slow. Trial using an earlier version of XL to reduce your wait time. HTH. Dave

Yeas I'm. Thanks for suggestion. I'll try.
My speciality is far away from coding. I found on internet workbook which downloads historical stock price data and modified it to my needs, sometimes by recording macros, sometimes by inserting pieces of codes found on internet again in the form of macros. So each workbook instead of one normal piece of code has set of macros which is triggered in certain order by master macros named Macros3. Basically for job to be done, after opening file I just have to run Macros3. I realise that it may sound silly, and for the same reason it may be slow.
 
Upvote 0

Forum statistics

Threads
1,223,984
Messages
6,175,781
Members
452,668
Latest member
mrider123

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