PDA

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



Anne Troy
10-10-2005, 05:49 PM
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
10-10-2005, 08:42 PM
This could be slow if the UsedRange and/or the number of worksheets is large :dunno 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:)

Anne Troy
10-11-2005, 10:58 AM
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
10-11-2005, 12:04 PM
John shows offline, I'll help him out ...

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

johnske
10-11-2005, 12:04 PM
Done :)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

johnske
10-11-2005, 12:07 PM
Hi Zack, I musta come online & posted at same time as you :rofl:

Anne Troy
10-11-2005, 12:08 PM
LOL. Thanks!!!

Zack Barresse
10-11-2005, 01:51 PM
LOL! Sorry John, didn't mean to step on your toes buddy.