Run the Code on All workbooks a folder contains

mythu · Feb 19th 2021

I have been trying to make a code that would run on all sheets a folder contains. But i am stuck that how to do this. I have wrote some line and gather information via google but difficult to create this one.

Here is the code which is required to run on all workbooks with sheet name i.e. DATA

Code

Dim ws As Worksheet
 Dim mySel As Range, aCell As Range

 Set ws = ThisWorkbook.Sheets("DATA")
 
 Set mySel = ws.UsedRange
 For Each aCell In mySel
 With aCell
 .Interior.Color = .DisplayFormat.Interior.Color
 End With
 Next aCell
 mySel.FormatConditions.Delete

Display More

Here is the second one which provide the option to select the folder.

Code

Sub Folder()
Dim strFolder As String
Dim strFile As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim I As Long
Dim xRg As Range


With Application.FileDialog(4)
If .Show Then
strFolder = .SelectedItems(1)
Else
MsgBox "You haven't selected a folder!", vbExclamation
Exit Sub
End If
End With
Application.ScreenUpdating = False
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
End Sub


strFile = Dir(strFolder & "*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open(strFolder & strFile)


For I = 2 To wbk.Worksheets.Count

Display More

Your help will be highly appreciated.

**Carim** · Feb 19th 2021

Hello,

You should clarify what is exactly your objective ...

Quote

all sheets a folder contains

- Worksheets are located in Workbooks

- Workbooks are located in a Folder

But Sheets cannot be located in a Folder ...

Hope this will help

mythu · Feb 19th 2021

Hi, Carim.

Just trying to keep the conditional formatting colors then code will delete all Conditional formatting. My below code is just working for single Workbook.Worksheets("DATA") at a time.

I am looking for a way to run this code on multiple workbooks at once by selecting a folder.

Code

Dim ws As Worksheet
 Dim mySel As Range, aCell As Range

 Set ws = ThisWorkbook.Sheets("DATA")
 
 Set mySel = ws.UsedRange
 For Each aCell In mySel
 With aCell
 .Interior.Color = .DisplayFormat.Interior.Color
 End With
 Next aCell
 mySel.FormatConditions.Delete

Display More

**royUK** · Feb 19th 2021

This will be faster on the whole workbook

Code

Sub KeepCF()
    Worksheets.Select
    Cells.Select
    On Error Resume Next
    With Selection.SpecialCells(xlCellTypeAllFormatConditions)
        .Interior.Color = .DisplayFormat.Interior.Color
        .FormatConditions.Delete
    End With
    On Error GoTo 0
End Sub

Do you want to browse for the folder or will it be fixed?

mythu · Feb 19th 2021

Thanks royUK for answering.

Exactly i want to browse the folder. Let me explain if the folder has 5 workbook then code will RUN on the 5 workbooks.

**royUK** · Feb 19th 2021

Try this, I haven't tested it so use some dummy workbooks

Code

Option Explicit

Sub KeepCF()
    Dim oWb As Workbook
    Dim aSht As Worksheet
    Dim sExt As String, sFilPath As String, sFil As String
    Dim FldrPicker As FileDialog
    
    
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo cancelled
        sFilPath = .SelectedItems(1) & "\"
    End With
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = True
        .EnableEvents = True
        
        ''/// if cancelled
cancelled:
        sFilPath = sFilPath
        If sFilPath = "" Then GoTo clean_up
        
        ''///Target File Extension (must include wildcard "*")
        sExt = "*.xls*"
        
        'Target Path with Ending Extention
        sFil = Dir(sFilPath & sExt)
        
        ''///Loop through each Excel file in folder
        Do While sFil <> ""
            ''///Set variable to opened workbook
            Set oWb = Workbooks.Open(Filename:=sFilPath & sFil)
            With oWb
                Set aSht = ActiveSheet
                oWb.Worksheets.Select
                Cells.Select
                On Error Resume Next
                With Selection.SpecialCells(xlCellTypeAllFormatConditions)
                    .Interior.Color = .DisplayFormat.Interior.Color
                    .FormatConditions.Delete
                End With
                On Error GoTo 0
                aSht.Select
                oWb.Close True
            End With
            
            DoEvents
            
            ''///Get next file name
            sFil = Dir
        Loop
clean_up:
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Display More

mythu · Feb 19th 2021

It is really working like rocket Thanks.

1. But there is some problem that it does not save the changes and close the workbooks after running the code.

2. when i run the code it makes the sheet color black i have attached a sheet for example. I have run the above code that you provided for single workbook does same for single workbook.

I have closed each workbook one by one after running the code.

**royUK** · Feb 19th 2021

This line in my code closes the workbook anfter saving

Code

oWb.Close True

This line is from your code so I assumed it worked.

Code

 .Interior.Color = .DisplayFormat.Interior.Color

Is this any better

Code

Sub KeepCF()
    Dim oWb As Workbook
    Dim aSht As Worksheet
    Dim rCl As Range
    Dim sExt As String, sFilPath As String, sFil As String
    Dim FldrPicker As FileDialog
    
    
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo cancelled
        sFilPath = .SelectedItems(1) & "\"
    End With
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = True
        .EnableEvents = True
        
        ''/// if cancelled
cancelled:
        sFilPath = sFilPath
        If sFilPath = "" Then GoTo clean_up
        
        ''///Target File Extension (must include wildcard "*")
        sExt = "*.xls*"
        
        'Target Path with Ending Extention
        sFil = Dir(sFilPath & sExt)
        
        ''///Loop through each Excel file in folder
        Do While sFil <> ""
            ''///Set variable to opened workbook
            Set oWb = Workbooks.Open(Filename:=sFilPath & sFil)
            With oWb
                Set aSht = ActiveSheet
                oWb.Worksheets.Select
                Cells.Select
                On Error Resume Next
                With Selection.SpecialCells(xlCellTypeAllFormatConditions)
                For Each rCl In .Cells
                    rCl.Interior.Color = rCl.DisplayFormat.Interior.Color
                    rCl.FormatConditions.Delete
                    Next rCl
                End With
                On Error GoTo 0
                ''/// deselect sheets
                aSht.Select
                ''///close and save
                oWb.Close True
            End With
            
            DoEvents
            
            ''///Get next file name
            sFil = Dir
        Loop
clean_up:
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Display More

mythu · Feb 19th 2021

Yup! now code is working fine but still does not close the workbooks.

mythu · Feb 19th 2021

and let me clear one more thing i have been downloading these files from google sheets.

Running this code on a new workbook which is not save in the system.

**royUK** · Feb 19th 2021

I'm not sure about Google Sheets, I hate using them.

Can you attach your workbook so I can see why it isn't closing the workbooks.

mythu · Feb 19th 2021

Yes you are right.

But job is to use them. below is attached workbook

**royUK** · Feb 19th 2021

I want to see the workbook that you put the code in.

mythu · Feb 19th 2021

Oh that workbook is MS Original file. which i open by right clicking on mouse. Then go to "New" then click on "Microsoft Excel Worksheet"

**royUK** · Feb 19th 2021

I'm sorry where is the code?

mythu · Feb 19th 2021

I do no understand your first message sorry for that. Below is the attached workbook.

I open this workbook randomly and saved as xlsm.

mythu · Feb 19th 2021

I have detected one more problem that it does not run on all workbooks that are available in folder may be the issue is all are downloaded Google Sheets.

**royUK** · Feb 19th 2021

Are they downloaded as excel files?

mythu · Feb 19th 2021

Yes.

From here.

**royUK** · Feb 19th 2021

It should loop through all excel files

Run the Code on All workbooks a folder contains

Participate now!

Share

Tags