Using .Offset with a fixed range

Question

The script below works without

.Offset(1, -4).Resize(.Rows.Count - 1, 1).Value = "TEST"

The script takes a list of iPads and Tablets on a spreadsheet and finds the ones that don't have SIM cards.

With the intended results, I need to offset back 2-3 columns and change D & E's result to "TEST" for example.

The code below runs for the G column and to get offset to work means expanding from (A:T). This breaks everything below though and now the script loses focus and doesn't know what to filter.

I know either set range needs changing, or I need to approach offset differently without losing the focus and accidently changing rows that aren't filtered.

Sub FilterOut()

Dim arr(): Dim arrResult()
Dim rg As Range: Dim i As Long

Set rg = Range("G:G")
arr = Application.Transpose(rg)

For i = LBound(arr) To UBound(arr)
    If InStr(arr(i), "SAMSUNG TABLET") <> 0 Or InStr(arr(i), "IPAD") <> 0 Then
    If InStr(arr(i), "64GB") <> 0 Then arr(i) = Replace(arr(i), "64GB", "!@!")
        If InStr(arr(i), "CELL") = 0 And InStr(arr(i), "4G") = 0 And InStr(arr(i), "5G") = 0 Then
            If InStr(arr(i), "!@!") <> 0 Then arr(i) = Replace(arr(i), "!@!", "64GB")
            j = j + 1
            ReDim Preserve arrResult(1 To j)
            arrResult(j) = arr(i)
        End If
    End If
Next i

With rg
    .AutoFilter Field:=1, criteria1:=arrResult, Operator:=xlFilterValues

    'My issue starts here:
    .Offset(1, -4).Resize(.Rows.Count - 1, 1).Value = "TEST"

End With

End Sub

I tried:

Set rg = Range("A:T")

.Offset(1, -4).Resize(.Rows.Count - 1, 1).Value = "TEST"

Run time error - Subscript error out of range

Answer 1

Your issue is in the first parameter of the Offset function - the row argument is set to 1, when your range rg is an entire column and therefore can't be offset up and down. If you replaced your existing .Offset(1, -4) with .Offset(0, -4) then it will not throw the error, although I'm not sure from your question what you're wanting to happen, whether this would be a satisfactory fix.

EDIT: Can't believe I didn't notice - if you do the Resize operation before the Offset, then the range being offset is no longer an entire column and it doesn't throw an error. So, replace

.Offset(1, -4).Resize(.Rows.Count - 1, 1).Value = "TEST"

with

.Resize(.Rows.Count - 1, 1).Offset(1, -4).Value = "TEST"

Answer 2

Set rg = Range("G:G") is over a million rows, the arr = Application.Transpose(rg) truncates it to 65,536. Scan the sheet down to the last row of data and update the rows directly, no need to filter.

Sub FilterOut2()

    Dim wb As Workbook, ws As Worksheet, s As String
    Dim rg As Range, i As Long, n As Long, lastrow As Long
    
    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet ' or wb.Sheets("SheetName")
    With ws
        lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
        For i = 1 To lastrow
            s = Replace(.Cells(i, "G"), "64GB", "")
            If (InStr(s, "SAMSUNG TABLET") > 0 _
             Or InStr(s, "IPAD") > 0) Then
             
                If InStr(s, "CELL") = 0 _
                   And InStr(s, "4G") = 0 _
                   And InStr(s, "5G") = 0 Then
                     .Cells(i, "C").Resize(, 2) = "TEST" ' C:D
                     n = n + 1
                End If
                
            End If
        Next
    End With
    MsgBox n & " rows updated", vbInformation

End Sub