Trying to loop through column B and if two cells in a row contain the same text then delete the firs-CodePudding

Need to loop through column B and if the cell contains the text in in quotes then need to delete the entire row of the first one and keep the second. Keep getting with block error

Dim i As Long
Dim rng As Range


rng = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row

For i = 1 To rng

If Cells(i, 1).Value = "FINANCE SYSTEM OF GREEN BAY, INC." And Cells(i, 1).Offset(1, 0).Value = "FINANCE SYSTEM OF GREEN BAY, INC." Then
Cells(i, 1).EntireRow.Delete

End If

Next i

CodePudding user response：

As stated above, deletion during the iteration from small to bigger is wrong, as the bad variable declaration. You can iterate backwards, but the best solution is to not delete a row at a time. Using a Union range and deleting its rows at the end is the fastest way:

Sub deleteRowsAtOnce()
   Dim sh As Worksheet, i As Long, lastRow As Long, rngDel As Range

  Set sh = Sheets("Sheet1")
  lastRow = sh.Range("B" & sh.rows.count).End(xlUp).row

 For i = 1 To lastRow
     If sh.cells(i, 1).value = "FINANCE SYSTEM OF GREEN BAY, INC." And _
            sh.cells(i, 1).Offset(1, 0).value = "FINANCE SYSTEM OF GREEN BAY, INC." Then
        If rngDel Is Nothing Then
            Set rngDel = sh.cells(i, 1)
        Else
            Set rngDel = Union(rngDel, sh.cells(i, 1))
        End If
    End If
 Next i
 If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

CodePudding user response：

Apart from your definition of rng as pointed out by @Bigben you are making the classic mistake of changing a range whilst you are iterating over it.

When you delete a row the number of rows reduces by 1. But VBA doesn't know this so the rng variable isn't automatically adjusted. The usual symptom is that some lines are not deleted or an index error. To do the deletions without affecting the yet to processed remainder of the range you need to iterate backwards, from Rng to 1 step -1.

CodePudding user response：

Delete Rows (Backward Loop)

Option Explicit

Sub KeepTheSecond()
    
    Const wsName As String = "Sheet1"
    Const Col As String = "B"
    Const CritString As String = "FINANCE SYSTEM OF GREEN BAY, INC."

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim LastRow As Long: LastRow = ws.Range(Col & ws.Rows.Count).End(xlUp).Row

    Dim r As Long
    
    For r = LastRow - 1 To 1 Step -1
        If StrComp(ws.Cells(r, Col).Value, CritString, vbTextCompare) = 0 Then
            If StrComp(ws.Cells(r, Col).Offset(1).Value, CritString, _
                    vbTextCompare) = 0 Then
                ws.Cells(r, Col).EntireRow.Delete
            End If
        End If
    Next r

End Sub