Trying to delete rows in a range by criteria in one column

[SGBCleve]

I have a range in a worksheet (eventually similar ranges in many worksheets). The range is 8 rows long and runs from columns B to I. The range is sorted in ascending order based on match criteria that return rows in column I for data in column E. I am trying to delete rows where the row matches are less than ten rows apart. It is crashing at the line which says Counter = rDataRange.Rows.Count (after it enters the loop). Do I need to delete this line and put a Counter = Counter -1 further down?

Sub DeleteCloseRows()
Dim rxRange As Range
Dim Counter As Integer
Dim rowValue1 As Long
Dim rowValue2 As Long
Dim rwNumber As Long
Dim j As Integer


Counter = 7


Set rxRange = Sheets(2).Range("I3757").Offset(1 * Counter - 1, 0) 'Highest row match is offset 7 rows from top of range.
'Set rDataRange = Sheets(2).Range("B3757:I3764")
Set rDataRange = Sheets(2).Range("B3757", Range("I3757").End(xlDown)) 'all row data is in rDataRange

Counter = rDataRange.Rows.Count 'counts rows in range - 8 to start


For j = 1 To Counter ' probably should be Counter -1
rDataRange = Sheets(2).Range("B3757", Range("I3757").End(xlDown)) ' defines data range as it changes
Counter = rDataRange.Rows.Count 'counts rows in data range
rxRange.Select 'selects bottom row of range
rowValue2 = rxRange.Value 'gets value of bottom row
rowValue1 = rxRange.Offset(-1, 0).Value 'gets value of row above

rwNumber = rxRange.Offset(0, 1).Value 'returns matchrow in range to delete if needed
If (rowValue2 - rowValue1 > 10) Then 'if row difference is greater than 10 don't delete and set the next comparison for line above and two lines above
rxRange = rxRange.Offset(-1, 0)

Else: rxRange = rxRange.Offset(-1, 0)
Range("B & rwNumber" & ":" & "J & rwNumber").Delete Shift:=xlToUp 'if row difference is < 10 delete row and move up

End If
Next j


End Sub

Thanks very much for looking. I am not very experienced with VBA coding, to say the least.

 

[Fluff]

Not sure if I've understood you correctly, but try this

Sub DeleteCloseRows()

    Dim Counter As Integer
    Dim j As Integer
    Dim rDataRange As Range

    'Set rDataRange = Sheets(2).Range("B3757:I3764")
    Set rDataRange = Sheets(2).Range("B3757", Range("I3757").End(xlDown)) 'all row data is in rDataRange
    
    Counter = rDataRange.Rows.Count 'counts rows in range - 8 to start
    
    
    For j = Counter To 1 Step -1 ' probably should be Counter -1
        If Range("I" & j).Value - Range("I" & j).Offset(-1).Value <= 10 Then
        Range("B" & j).Resize(, 9).Delete Shift:=xlToUp 'if row difference is < 10 delete row and move up
        End If
    Next j


End Sub

This is UNtested, so make sure you try it on a COPY of your data