VBA code issue: Using offset while looping through a range for a specific Value-CodePudding

Ive written a VBA code to loop through a range for a specific value, selecting the cell containing that value, the cell immediately above it and the cell immediately below it using offset. The issue is that the code selects for the first instance of the cell value been looked for 1111, and the two offsets (selects for 1111, the cell immediately above it, and the one immediately below it), but not for the remainder of the specified value in the range and their respective (cell immediately above and below them) offsets. Kindly assist

Looping through range for specific value using offset

The code:

Sub SelectMatchingCell()

Dim strInt As Integer

Dim rng As Range, c As Range, MyRng As Range, offsetCell1 As Range, offsetCell2 As Range
 
'Set range with values to be searched for matches

    Set rng = ActiveSheet.Range("J3:J10555")

'Fill string variable with string of text to be matched

    strInt = 1111
 
'Loop through each cell in range

For Each c In rng

'Check if cell value matches the string to be matched

    If c.Value = strInt Then

'Check if this is the first match (new range hasn't been filled yet)

        If MyRng Is Nothing Then

'Fill new range with cell

            Set MyRng = c
            Set offsetCell1 = MyRng.Cells.Offset(-1, 0)
            Set offsetCell2 = MyRng.Cells.Offset(1, 0)

        Else
'Join new matching cell together with previously found matches

            Set MyRng = Application.Union(MyRng, c, offsetCell1, offsetCell2)

        End If
    End If
Next c
 
'Select entire row of each cell in new range
MyRng.Cells.Select
End Sub

CodePudding user response：

You only set offsetCell1 and offsetCell2 during your first match. You need to include those two lines in your Else statement as well.

    If c.Value = strInt Then

'Check if this is the first match (new range hasn't been filled yet)

    If MyRng Is Nothing Then

'Fill new range with cell

        Set offsetCell1 = c.Cells.Offset(-1, 0)
        Set offsetCell2 = c.Cells.Offset(1, 0)
        Set MyRng = Application.Union(c, offsetCell1, offsetCell2)

    Else
'Join new matching cell together with previously found matches

        Set offsetCell1 = c.Cells.Offset(-1, 0)
        Set offsetCell2 = c.Cells.Offset(1, 0)
        Set MyRng = Application.Union(MyRng, c, offsetCell1, offsetCell2)

    End If