Home > Blockchain >  Faster code to find the colored cells (Interior) ,OR speed up `For each` Loop
Faster code to find the colored cells (Interior) ,OR speed up `For each` Loop

Time:06-28

I am using below code to select the colored cells (interior) on UsedRange exclude First Row.
It works ,but it is slow with huge ranges e.g 20k.
Is there a faster method or speed up For each Loop.
In advance, grateful for all your help.

Application.ScreenUpdating = False
 
  Dim ws As Worksheet: Set ws = ActiveSheet
 
  Dim crg As Range      'UsedRange exclude First Row
  Set crg = ws.UsedRange
  Set crg = crg.Offset(1, 0).Resize(crg.Rows.Count - 1, crg.Columns.Count)
 
  Dim mystr, cel As Range, FinalRange As Range
   mystr = ""
     For Each cel In crg
         If cel.Interior.ColorIndex <> -4142 Then
            mystr = mystr & cel.Address & ","
         End If
      Next
    If mystr = "" Then
        MsgBox "No colored cell found"
     Else
        Set FinalRange = ws.Range(Left(mystr, Len(mystr) - Len(",")))
    End If
 
    Application.ScreenUpdating = True

CodePudding user response:

yes you can consider the colored cell have only one color yellow

Maybe this kind of code is faster ?

Sub test()  
Set crg = ws.UsedRange
Set crg = crg.Offset(1, 0).Resize(crg.Rows.Count - 1, crg.Columns.Count)

  With Application.FindFormat
  .Clear
  .Interior.Color = vbYellow
  .Locked = True
  End With

Dim rg As Range
Set c = crg.Find(What:=vbNullString, SearchFormat:=True)

    If Not c Is Nothing Then
        FirstAddress = c.Address
            Do
                If rg Is Nothing Then Set rg = c Else Set rg = Union(rg, c)
                Set c = crg.Find(What:=vbNullString, after:=c, SearchFormat:=True)
            Loop While c.Address <> FirstAddress
        rg.Select
    Else
        MsgBox "no cell with yellow color found"
    End If

End Sub

The final result will select all the cells with yellow color or show a message box
So, it doesn't loop to each cell in crg and check if the looped cell color is yellow, but directly find within crg which cell with the yellow color, then get the c as rg variable, find the next cell with yellow color, then union the rg with c.

  • Related