Macros for editing multiple workbooks

[dilshod_k]

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.

 

[NdNoviceHlp]

Seems like this should work. HTH. Dave

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

 

[dilshod_k]

Seems like this should work. HTH. Dave

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

 

[Stiuart_W]

Change If Fl.Name Like "*.xls*" Then to

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

 

[dilshod_k]

Yeah, already done that , 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.

 

[NdNoviceHlp]

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.

 

[dilshod_k]

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.

 

[dilshod_k]

Change If Fl.Name Like "*.xls*" Then to

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

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

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


Thanks a lot for help. Appreciate it.

 

[NdNoviceHlp]

I'm guessing your using XL 2016 … it's slow. Trial using an earlier version of XL to reduce your wait time. HTH. Dave

 

[dilshod_k]

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.