Application-defined error when looping through ranges

Question

I'm trying to loop through different ranges replacing the cells with the value '1' with another value/format.

If I use the ranges one by one, it works great. But when I'm trying to combine the different ranges and loop through the array I'm getting an Application-defined Runtime error at the .Pattern part.

I've read it has something to do with not defining the sheet, but I'm not sure how to do that correctly in this set-up.

I already tried:

the code with a single range without the i-loop: code works
add ActiveSheet to the with-loop: With Activesheet.Range(DRng).cell: fail
add different ways to refer to the range/sheet: fail

cell.select before with cell.interior

Sub SetTelSlot()


Dim cell As Range
Dim DRng(1 To 5) As Range
Dim i As Long


Set DRng(1) = Range("E7:AB33")
Set DRng(2) = Range("E45:AB71")
Set DRng(3) = Range("E82:AB108")
Set DRng(4) = Range("E119:AB145")
Set DRng(5) = Range("E156:AB182")


For i = LBound(DRng) To UBound(DRng)

For Each cell In DRng(i)
    If cell.Value = "1" Then


With cell.Interior
        .Pattern = xlSolid        '==>this is giving the error
        .PatternColorIndex = xlAutomatic
        .Color = RGB(0, 204, 153)
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    cell.Font.Bold = SetBold
    cell.Font.Color = vbBlack
    cell.Value = "T"

    End If

    Next cell

Next i

End Sub

user1016274 user1016274 · Accepted Answer · 2019-05-20T11:55:01

As a suggestion: instead of looping through every cell in every range you could just build a single range object which comprises all ranges, and search for matching cells in this range:

Sub SetTelSlot()
    Dim c As Range, DRng As Range
    Dim firstfound As String

    With ActiveSheet
        Set DRng = Union( _
            .Range("E7:AB33"), _
            .Range("E45:AB71"), _
            .Range("E82:AB108"), _
            .Range("E119:AB145"), _
            .Range("E156:AB182") _
        )
    End With
    With DRng
        Set c = .Find("1", LookIn:=xlValues)
        If Not c Is Nothing Then
            firstfound = c.Address
            Do
                ' action
                With c
                    .Font.Bold = SetBold
                    .Font.Color = vbBlack
                    .Value = "T"
                    With .Interior
                        .pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = RGB(0, 204, 153)
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                End With

                ' find next
                Set c = .FindNext(c)
                If c Is Nothing Then
                    Exit Do
                End If
            Loop While c.Address <> firstfound
        End If
    End With
End Sub

The FindNext method will wrap around to the beginning of the range after reaching it's end; so the first matching address is compared to end the loop.

Application-defined error when looping through ranges

2 Answers