Solved: Find ALL Cell Fill Colors and Make them One Color

[Anne Troy]

I've got peach and green and all sorts of cell fill colors in use.

Without affecting those that are conditionally formatted, I'd like to find all cells filled with color and make them all the same color... any color you like is fine; well...except black.

[johnske]

This could be slow if the UsedRange and/or the number of worksheets is large [vba]Sub ChangeCellColors_OneWorksheet()
Dim Cell As Range
Application.ScreenUpdating = False
For Each Cell In ActiveSheet.UsedRange
If Cell.Interior.ColorIndex <> xlColorIndexNone Then
Cell.Interior.ColorIndex = 35
End If
Next
Application.ScreenUpdating = True
Set Cell = Nothing
End Sub

Sub ChangeCellColors_EntireWorkBook()
Dim Cell As Range, Sheet As Worksheet
Application.ScreenUpdating = False
For Each Sheet In Worksheets
Sheet.Activate
For Each Cell In ActiveSheet.UsedRange
If Cell.Interior.ColorIndex <> xlColorIndexNone Then
Cell.Interior.ColorIndex = 35
End If
Next Cell
Next Sheet
Application.ScreenUpdating = True
Set Sheet = Nothing
Set Cell = Nothing
End Sub[/vba]

[Anne Troy]

Works terrific, John. Could you possibly add a status bar message to tell us what sheet (or what sheet number) it's on? Would love that!!

[Zack Barresse]

John shows offline, I'll help him out ...

[vba]Sub ChangeCellColors_EntireWorkBook()
Dim Cell As Range, Sheet As Worksheet
Application.ScreenUpdating = False
For Each Sheet In Worksheets
Application.StatusBar = "Working on " & Sheet.Index & " of " & Worksheets.Count & " - " & Sheet.Name
For Each Cell In Sheet.UsedRange
If Cell.Interior.ColorIndex <> xlColorIndexNone Then
Cell.Interior.ColorIndex = 35
End If
Next Cell
Next Sheet
Application.ScreenUpdating = True
Application.StatusBar = False
Set Sheet = Nothing
Set Cell = Nothing
End Sub[/vba]

[johnske]

Done [vba]Sub ChangeCellColors_EntireWorkBook()
Dim Cell As Range, Sheet As Worksheet, N As Long
Application.ScreenUpdating = False
N = 1
For Each Sheet In Worksheets
Sheet.Activate
For Each Cell In ActiveSheet.UsedRange
If Cell.Interior.ColorIndex <> xlColorIndexNone Then
Cell.Interior.ColorIndex = 35
End If
Next Cell
Application.StatusBar = "Progress: " & N & _
" Sheets done" & " out of " & Worksheets.Count
DoEvents
N = N + 1
Next Sheet
Application.ScreenUpdating = True
Set Sheet = Nothing
Set Cell = Nothing
End Sub[/vba]

[johnske]

Hi Zack, I musta come online & posted at same time as you

[Anne Troy]

LOL. Thanks!!!

[Zack Barresse]

LOL! Sorry John, didn't mean to step on your toes buddy.