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.