Removing Specific Fill Colors

[SamT]

  Set cellRange = ws.UsedRange.Find("*", SearchFormat:=True) 'Note "Find"
    Do While Not cellRange Is Nothing
        cellRange.Interior.Color = xlNone
        hasChange = true
        Set cellRange = FindNext(cellRange) 'Note lack of Range
    Loop

I would use

' Place at top of Procedure
Dim X
Dim SearchRange As Range
' End Placement
Set SearchRange = Nothing ' Start Fresh with next ws.
X = Timer
Set SearchRange = ws.UsedRange
For each targetColorKey In dictColors.Keys
    Application.FindFormat.Interior.Color = targetColorKey
    Set cellRange = SearchRange.Find("*", SearchFormat:=True) ' Note SearchRange include ws and UsedRange
    Do While Not cellRange Is Nothing
         cellRange.Interior.Color = xlNone
         hasChange = true
         Set cellRange = FindNext(cellRange)
    Loop
    Set CellRange = Nothing ' Start Fresh with next Color
Next targetColorKey
Debug.Print "Process took " & Timer - X & " Seconds."
' Next ws 'Not used at this time

Note that I would only time the While loop, pausing before each ColorKey. I would also add one ColorKey that did NOT exist on the sheet, just to have a baseline. If you have several thousand Cells, the baseline could be large. If all the colored Cells are in a few columns, shrink SearchRange to only those columns. It is quite possible that UsedRange is much larger than it appears.

Run This Code before working on any ws. VBA Express : Excel - Reduce Excel File Size. It will set UsedRange accurately.