Open Multiple Excel Files and manipulate data

D

Donal28

Well-known Member
Joined
Apr 23, 2010
Messages
527
Hi All

I'm want to open multiple Excel files in multiple folders and then enter a COUNTIF formula in cell Q1204 of each sheet, replace all the "degrees" words with blank spaces in each sheet and then add a custom filter with values above 97 in column AK:AK in each sheet. I have the code below to do the last 3 bits but not sure how to open the multiple files in multiple folders. Any help on this would be very much appreciated

Range("Q1204").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-3],0)"
Cells.Replace What:="degrees", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.Range("$A$1:$AK$1201").AutoFilter Field:=37, Criteria1:=Array( _
"97", "98", "99"), Operator:=xlFilterValues
ActiveWindow.SmallScroll Down:=3

Regards
Donal
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
The following macro will loop through each file within each subfolder of your main folder...

Code: 
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=darkblue]Dim[/color] objFSO [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] objFolder [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] objSubFolder [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] objFile [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] strMainFolder [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] wkbTarget [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wksTarget [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] CalcMode [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]With[/color] Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = [color=darkblue]False[/color]
        .ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]Set[/color] objFSO = CreateObject("Scripting.FileSystemObject")
    
    strMainFolder = "C:\MainFolder"  [color=green]'change the path accordingly[/color]
    
    [color=darkblue]Set[/color] objFolder = objFSO.GetFolder(strMainFolder)
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] objSubFolder [color=darkblue]In[/color] objFolder.SubFolders
        [color=darkblue]For[/color] [color=darkblue]Each[/color] objFile [color=darkblue]In[/color] objSubFolder.Files
            [color=darkblue]If[/color] objFile.Type = "Microsoft Excel Worksheet" [color=darkblue]Then[/color]  [color=green]'checks for an .xlsx file[/color]
                Cnt = Cnt + 1
                [color=darkblue]Set[/color] wkbTarget = Workbooks.Open(objFile)
                [color=darkblue]Set[/color] wksTarget = wkbTarget.ActiveSheet
                [color=darkblue]With[/color] wksTarget
                    .Range("Q1204").FormulaR1C1 = "=COUNTIF(C[-3],0)"
                    .Cells.Replace What:="degrees", Replacement:="", LookAt:=xlPart, _
                        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=[color=darkblue]False[/color], _
                        ReplaceFormat:=False
                    .Range("$A$1:$AK$1201").AutoFilter Field:=37, Criteria1:=Array( _
                        "97", "98", "99"), Operator:=xlFilterValues
                [color=darkblue]End[/color] [color=darkblue]With[/color]
                wkbTarget.Close savechanges:=[color=darkblue]True[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] objFile
    [color=darkblue]Next[/color] obj[color=darkblue]Sub[/color]Folder
    
    [color=darkblue]With[/color] Application
        .Calculation = CalcMode
        .EnableEvents = [color=darkblue]True[/color]
        .ScreenUpdating = [color=darkblue]True[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]If[/color] Cnt = 0 [color=darkblue]Then[/color]
        MsgBox "No Excel files have been found...", vbExclamation
    [color=darkblue]Else[/color]
        MsgBox "Completed...", vbInformation
    [color=darkblue]End[/color] [color=darkblue]If[/color]

End Sub
[/font]
 
Upvote 0
Domenic said:
The following macro will loop through each file within each subfolder of your main folder...

Code: 
[FONT=Verdana][COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=darkblue]Sub[/COLOR] test()[/FONT]
 
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] objFSO [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] objFolder [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] objSubFolder [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] objFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] strMainFolder [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] wkbTarget [COLOR=darkblue]As[/COLOR] Workbook[/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] wksTarget [COLOR=darkblue]As[/COLOR] Worksheet[/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] CalcMode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]Dim[/COLOR] Cnt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR][/FONT]
 
[FONT=Verdana]   [COLOR=darkblue]With[/COLOR] Application[/FONT]
[FONT=Verdana]       CalcMode = .Calculation[/FONT]
[FONT=Verdana]       .Calculation = xlCalculationManual[/FONT]
[FONT=Verdana]       .EnableEvents = [COLOR=darkblue]False[/COLOR][/FONT]
[FONT=Verdana]       .ScreenUpdating = [COLOR=darkblue]False[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR][/FONT]
 
[FONT=Verdana]   [COLOR=darkblue]Set[/COLOR] objFSO = CreateObject("Scripting.FileSystemObject")[/FONT]
 
[FONT=Verdana]   strMainFolder = "C:\MainFolder"  [COLOR=green]'change the path accordingly[/COLOR][/FONT]
 
[FONT=Verdana]   [COLOR=darkblue]Set[/COLOR] objFolder = objFSO.GetFolder(strMainFolder)[/FONT]
 
[FONT=Verdana]   [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] objSubFolder [COLOR=darkblue]In[/COLOR] objFolder.SubFolders[/FONT]
[FONT=Verdana]       [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] objFile [COLOR=darkblue]In[/COLOR] objSubFolder.Files[/FONT]
[FONT=Verdana]           [COLOR=darkblue]If[/COLOR] objFile.Type = "Microsoft Excel Worksheet" [COLOR=darkblue]Then[/COLOR]  [COLOR=green]'checks for an .xlsx file[/COLOR][/FONT]
[FONT=Verdana]               Cnt = Cnt + 1[/FONT]
[FONT=Verdana]               [COLOR=darkblue]Set[/COLOR] wkbTarget = Workbooks.Open(objFile)[/FONT]
[FONT=Verdana]               [COLOR=darkblue]Set[/COLOR] wksTarget = wkbTarget.ActiveSheet[/FONT]
[FONT=Verdana]               [COLOR=darkblue]With[/COLOR] wksTarget[/FONT]
[FONT=Verdana]                   .Range("Q1204").FormulaR1C1 = "=COUNTIF(C[-3],0)"[/FONT]
[FONT=Verdana]                   .Cells.Replace What:="degrees", Replacement:="", LookAt:=xlPart, _[/FONT]
[FONT=Verdana]                       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=[COLOR=darkblue]False[/COLOR], _[/FONT]
[FONT=Verdana]                       ReplaceFormat:=False[/FONT]
[FONT=Verdana]                   .Range("$A$1:$AK$1201").AutoFilter Field:=37, Criteria1:=Array( _[/FONT]
[FONT=Verdana]                       "97", "98", "99"), Operator:=xlFilterValues[/FONT]
[FONT=Verdana]               [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR][/FONT]
[FONT=Verdana]               wkbTarget.Close savechanges:=[COLOR=darkblue]True[/COLOR][/FONT]
[FONT=Verdana]           [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR][/FONT]
[FONT=Verdana]       [COLOR=darkblue]Next[/COLOR] objFile[/FONT]
[FONT=Verdana]   [COLOR=darkblue]Next[/COLOR] obj[COLOR=darkblue]Sub[/COLOR]Folder[/FONT]
 
[FONT=Verdana]   [COLOR=darkblue]With[/COLOR] Application[/FONT]
[FONT=Verdana]       .Calculation = CalcMode[/FONT]
[FONT=Verdana]       .EnableEvents = [COLOR=darkblue]True[/COLOR][/FONT]
[FONT=Verdana]       .ScreenUpdating = [COLOR=darkblue]True[/COLOR][/FONT]
[FONT=Verdana]   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR][/FONT]
 
[FONT=Verdana]   [COLOR=darkblue]If[/COLOR] Cnt = 0 [COLOR=darkblue]Then[/COLOR][/FONT]
[FONT=Verdana]       MsgBox "No Excel files have been found...", vbExclamation[/FONT]
[FONT=Verdana]   [COLOR=darkblue]Else[/COLOR][/FONT]
[FONT=Verdana]       MsgBox "Completed...", vbInformation[/FONT]
[FONT=Verdana]   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR][/FONT]
 
[FONT=Verdana]End Sub[/FONT]
Click to expand...

Hi Domenic, thanks for the reply

I'm getting an Error saying that "No Excel files have been found" when I change the path to

strMainFolder = "Z:\TMDS Downloads"

There are 46 sub folders in Z:\TMDS Downloads" which are TS 1 to TS 46 all of which contain Excel files


 
Upvote 0
Hi Donal28,

What type of files do you have? As it stands, the macro searches for .xlsx files. To search for .xlsm files, replace...

Code: 
If objFile.Type = "Microsoft Excel Worksheet" Then

with

Code: 
If objFile.Type = "Microsoft Excel Macro-Enabled Worksheet" Then

Or, to search for .xls files...

Code: 
If objFile.Type = "Microsoft Excel 97-2003 Worksheet" Then

Or, to search for all Excel files...

Code: 
If InStr(1, objFile.Name, ".xls") > 0 Then
 
Upvote 0
Not to guess:

Code: 
If objFso.GetExtensionName(objFile.Name) Like "xls*"  Then
....
 
Upvote 0
Yes the files are all .xls so the last options has worked perfectly...thanks so much for your help :)
 
Upvote 0
Donal28 said:
Yes the files are all .xls so the last options has worked perfectly...thanks so much for your help :)
Click to expand...

You're very welcome! By the way, the last option I offered searches for all Excel files (.xls, xlsx, xlsm, etc.), not just .xls files. Same thing with Sektor's suggestion.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
replace data for multiple sheets from source file to destination file based on back up(date,time)
Replies
1
Views
174
leap out
L
G
  • Question Question
remove columns from multiple Excel-files in a folder
Replies
5
Views
276
gjvv
G
A
  • Solved
Extract and Merge Files
Replies
1
Views
132
rowebca
rowebca
N
  • Question Question
Repeat macro on multiple files
Replies
1
Views
295
NickvdB
N
S
  • Solved
Gathering Data From Multiple Files in Same Folder in Particular Range
9 10 11
Replies
105
Views
2K
shah0101
S

Forum statistics

Threads
1,224,517
Messages
6,179,239
Members
452,898
Latest member
Capolavoro009

Share this page

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