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

Share

Tags