Feb 19 2021 10:51 AM
I am using a code which keeps the color and remove the conditional formatting. I have multiple files where i run this code for each file separately.
I am looking for a way that when i run the code it will popup the window for the selection of the folder. I will select the folder which contains multiple files then one by one code will run each file where it will keep the colors and remove the condition formatting then save and close the workbook.
I just tried to make these below code but really do not know how to develop further. Your help will be greatly appreciated.
Sub Format()
Dim ws As Worksheet
Dim mySel As Range, aCell As RangeSet ws = ThisWorkbook.Sheets("Data)
Set mySel = ws.UsedRange
For Each aCell In mySel
With aCell
.Font.FontStyle = .DisplayFormat.Font.FontStyle
End With
Next aCell
mySel.FormatConditions.Delete
End Sub
And code to open the window.
Feb 19 2021 12:14 PM
SolutionTry this - please test it on a copy of your folder first.
It will handle font name, font style, font color and fill color, but not fill effects, borders or number formatting. The code could be expanded for those.
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
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
Application.ScreenUpdating = False
strFile = Dir(strFolder & "*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open(strFolder & strFile)
For Each wsh In wbk.Worksheets
For Each xRg In wsh.UsedRange
If xRg.FormatConditions.Count Then
xRg.Font.Name = xRg.DisplayFormat.Font.Name
xRg.Font.FontStyle = xRg.DisplayFormat.Font.FontStyle
xRg.Font.Color = xRg.DisplayFormat.Font.Color
If xRg.DisplayFormat.Interior.ColorIndex = xlColorIndexNone Then
xRg.Interior.ColorIndex = xlColorIndexNone
Else
xRg.Interior.Color = xRg.DisplayFormat.Interior.Color
End If
End If
Next xRg
wsh.UsedRange.FormatConditions.Delete
Next wsh
strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Mar 01 2021 10:38 AM
Mar 01 2021 11:08 AM
Feb 19 2021 12:14 PM
SolutionTry this - please test it on a copy of your folder first.
It will handle font name, font style, font color and fill color, but not fill effects, borders or number formatting. The code could be expanded for those.
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
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
Application.ScreenUpdating = False
strFile = Dir(strFolder & "*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open(strFolder & strFile)
For Each wsh In wbk.Worksheets
For Each xRg In wsh.UsedRange
If xRg.FormatConditions.Count Then
xRg.Font.Name = xRg.DisplayFormat.Font.Name
xRg.Font.FontStyle = xRg.DisplayFormat.Font.FontStyle
xRg.Font.Color = xRg.DisplayFormat.Font.Color
If xRg.DisplayFormat.Interior.ColorIndex = xlColorIndexNone Then
xRg.Interior.ColorIndex = xlColorIndexNone
Else
xRg.Interior.Color = xRg.DisplayFormat.Interior.Color
End If
End If
Next xRg
wsh.UsedRange.FormatConditions.Delete
Next wsh
strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub