I'm trying to find solution for my VBA project which requires to select and copy data from cells which are colored with certain colour (I know that there is no need to select range before copy, but at this point I just check how selecting range input works). I tried one solution provided by dollarexcel.com (with some modifications), but when I exceed certain range I get error '1004' - Method 'Range' of object '_Global' failed. With smaller ranges it works fine.

Here is code, I changed it to find colored cells in fixed range, not in current selection (but it also generated same error if manually selected range was too big). Error highlists third line from the bottom. I would appreciate any help with this issue.

Sub select_cells_with_colour()

Dim selected_Range As Range
Set selected_Range = Range("H20:I33")
mystr = ""
    For Each cellitem In selected_Range
         If cellitem.Interior.ColorIndex = 37 Then
            mystr = mystr & cellitem.Address & ","
         End If
    Next
    If mystr = "" Then
        MsgBox "No colored cell found"
    Else
        Range(Left(mystr, Len(mystr) - Len(","))).Select
    End If
End Sub

CodePudding user response：

Select Cells With the Same Color Index

Option Explicit

Sub SelectCellsWithColorIndex()

    Const rgAddress As String = "H20:I33"
    Const cIndex As Long = 37
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rg As Range: Set rg = ws.Range(rgAddress)
    
    Dim crg As Range
    Dim cell As Range
    
    For Each cell In rg.Cells
        If cell.Interior.ColorIndex = cIndex Then
            If crg Is Nothing Then
                Set crg = cell
            Else
                Set crg = Union(crg, cell)
            End If
        End If
    Next cell
    
    If crg Is Nothing Then
        MsgBox "No colored cells found.", vbExclamation
    Else
        crg.Select
    End If
    
End Sub