Consulting

Results 1 to 7 of 7

Thread: Removing Specific Fill Colors

  1. #1

    Post Removing Specific Fill Colors

    Hi,

    I would like to ask for any advice on how to make my VBA code run faster. What I'm doing is, I have a list of workbooks that I need to check if each worksheet inside it contains the target fill colors that I'm looking. If a target fill color is seen in the current worksheet, I remove the fill color.

    I already set Application.ScreenUpdating to False and minimize the usage of .Select(), but it is still slow.

    My code is something like this. This function is being called by another function, since I need to check each sheet in the current workbook

    Public Function removeFillColors(ws as Worksheet)
    Dim searchKey as Range Dim cellRange as Range ' This looks at the sheet for a specific keyword ' If the keyword is found, proceed to the removing of fill colors Set searchKey = GetSearchKey(ws) If not searchKey Is Nothing Then
    'Loop each cell in UsedRange
    For each cellRange In ws.UsedRange
    'If the cell's fill color exist in my dictionary of target fill colors 'Remove the fill color of the current cell
    If dictColors.Exists(cellRange.Interior.Color) Then
    cellRange.Interior.Color = xlNone
    End If
    next cellRange
    End IF
    End Function
    If my list contains only one file, it takes about 16 seconds. But if I add another file, it really takes time that I'm forced to stop it.

    Would really appreciate if someone can give me an advice on how to solve my problem.
    Last edited by DivineKael; 07-21-2021 at 06:41 AM. Reason: Adding additional info

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
    A hint:
    For each IC in (DictColors)
       Application.FindFormat.Interior.Color = IC
    
      Set Cel = UsedRange.Find(*, SearchFormat=True) 
      Do While Not Cel is Nothing
          Cel.Interior.Color = xlNone
          Set Cel = FindNext(Cel)
      Loop
    Next IC
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    I have tried updating my code to the hint you gave me. I tried testing it first on 1 file but it seems it's skipping the cells that has no value(but has the target fill color to be removed).
    I also noticed that it also taking too much time to reach the "Debug" statement (even until now). I'm not really used to VBA yet, so I'm not sure what part I'm having mistakes.

    For each targetColorKey In dictColors.Keys
        Application.FindFormat.Interior.Color = targetColorKey
        
        Set cellRange = ws.UsedRange("*", SearchFormat:=True)
        Do While Not cellRange Is Nothing
            cellRange.Interior.Color = xlNone
            hasChange = true
            Set cellRange = ws.UsedRange.FindNext(cellRange)
        Loop
    Next targetColorKey
    
    Debug.Print "Procees has reached here..."

  4. #4
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
      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.
    Last edited by SamT; 07-21-2021 at 11:39 AM.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  5. #5
    Question on the part below, is it supposed to be like this? Because I'm having compilation error.
    Assuming that it should be SearchRange.FindNext, I just noticed when it enters the while statement it will remove all fill colors regardless if its the "target fill color".
    It seems like if it found a cell with the target fill color, starting from that cell, it will check each individual cell and removed the fill color.

    Public Function removeFillColors(ws Worksheet)
        call ExcelDiet(ws) <---- I added the code you referred me
        ....
        Do While Not cellRange Is Nothing
             cellRange.Interior.Color = xlNone
             hasChange = true
             Set cellRange = FindNext(cellRange) <---- This should be like SearchRange.FindNext(cellRange) right?
        Loop
    End Function

  6. #6
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
    Well... I learned something: It appears that you can't use FindFormat with FindNext. So... new Code

    Replace from "For Each" to "Next targetColorKey".
    Note "Record hasChange here".
    hasChange = False 'Start Fresh with each ws
    
    For Each targetColorKey In dictColors.Keys
        Application.FindFormat.Interior.Color = targetColorKey
    
        Set CellRange = SearchRange.Find(What:="*", After:=SearchRange.Cells(SearchRange.Cells.Count), SearchFormat:=True) 'Start searching at TopLeft (After the BottomRight cell)
        If Not CellRange Is Nothing Then
             Do
                CellRange.Interior.Color = xlNone
                hasChange = True
                Set CellRange = SearchRange.Find(What:="*", After:=CellRange, SearchFormat:=True)
            Loop While Not CellRange Is Nothing
        End If
        Set CellRange = Nothing 'Start Fresh with next Color
    Next targetColorKey
    
    'Record hasChange here '<---------------
    Let me know how it goes. S'il vous plaît.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  7. #7
    I tried executing base on the changes above but when I look at the output the cells that doesn't have text value(but has fill color) were not removed. Sorry if I'm not clear with my problem.

    For example if you look at the image below. The cells encircled with blue were correctly removed, but the fill color for those cells that doesn't have text value were not remove(Example, the one encircled with red). I wanted to remove the target fill colors in all sheets, regardless if they text or not.
    Capture.PNG

    I cant really think of any other way other than traversing my ws.UsedRange and checking if it has the target color(which is taking a looong time)
    Last edited by DivineKael; 07-21-2021 at 11:25 PM. Reason: Added additional info

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •