Delete entire row by checking adjacent column values using vba

Question

I have a sheet with strings in column B for around 500 rows and I have cells empty/populated with values in column A and Column C to M.

I wrote a macro which will take the string value in each row in column B and if the adjacent cells (from column C to M) of that row are empty then it will delete that entire row. But even if any one of that adjacent cell has values then it will skip that row.

Here is my sheet looks like

 A      B           C   D   E   F   G   H   I   J   K   L   M
1.2   SERVER_P             RE1                         GR5 
7.3   PROXY NET
4.5   NET CON V1                        GR

Expected is it should delete entire 2 row since the coulms C to M are empty. I have given three rows as example above, but my sheet contains around 500 rows of data.

Here is what I have now

Dim rcount As Long, ccount As Long
Dim Count As Long, Lastrow As Long
Dim Targetname As String, Deletedname As String
Dim objFSObject As Object

Set objFSObject = CreateObject("Scripting.FileSystemObject")

Count = 0
Sheets("Sheet2").Activate

With ActiveSheet
    'count the rows till which strings are there
    Lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

For rcount = 1 To Lastrow
    Targetname = Cells(rcount, 2).Value
    Count = 0                     'reset the counter 
    Cells(rcount, 2).Select
    For ccount = 1 To 11
        Deletedname = ActiveCell.Offset(0, ccount).Value
        If Len(Trim$(Deletedname)) > 0 Then
            ccount = 11
        Else
            Count = Count + 1
            If Count = 11 Then
                Rows(rcount).EntireRow.Delete
            End If
        End If
    Next ccount
Next rcount

But my macro deletes many rows which meets the condition i.e. C to M are empty, but few rows are still not deleted and their cells are also empty from column C to M.

Could some one help me with this.

You need to work from the bottom of the sheet to the top if you're deleting rows - every time you delete a row it changes the row indexes. — Comintern
The change to your code is minimal: For rcount = Lastrow to 1 Step -1 — Logan Reed
Also, and this is more of an aside than a fix, you need to always qualify what sheet you expect the data to be on. You did this in your first with statement, but don't in your For loop. Also, it's best to avoid using .Select/.Activate — BruceWayne
Thanks @Comintern I dint think of that scenario, thats why it was skipping few rows ! — S6633d

S6633d S6633d · Accepted Answer · 2016-12-04T04:04:57

With the help of @Logan Reed comment above

  Dim rcount As Long, ccount As Long
  Dim Count As Long, Lastrow As Long
  Dim Targetname As String, Deletedname As String
  Dim objFSObject As Object

  Set objFSObject = CreateObject("Scripting.FileSystemObject")

  Count = 0
  Sheets("Sheet2").Activate

  With ActiveSheet
     'count the rows till which strings are there
     Lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
  End With

  For rcount = Lastrow to 1 Step -1
    Targetname = Cells(rcount, 2).Value
    Count = 0                     'reset the counter 
    Cells(rcount, 2).Select
      For ccount = 1 To 11
         Deletedname = ActiveCell.Offset(0, ccount).Value
         If Len(Trim$(Deletedname)) > 0 Then
             ccount = 11
         Else
             Count = Count + 1
             If Count = 11 Then
                Rows(rcount).EntireRow.Delete
             End If
         End If
      Next ccount
  Next

Delete entire row by checking adjacent column values using vba

1 Answers