Excel VBA - Delete Rows Based on Criteria

1
votes

I have a report that I pull everyday that is placed in a very awekward format. It's contains a variable row count by 4 columns organized into unofficial tables based on the Name of each employee.

What I have is an employee name in column B preceded 2 blank rows above and followed by 1 blank row of data below.

What I want to accomplish is loop through the data, identify cells in column B <> blank, delete the entire 2 rows below that cell, and delete the entire 1 row above that cell.

Below is what I have so far. not much:

Sub test()

Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long
Dim lastCol As Long
Dim i as integer

Set currentSht = ActiveWorkbook.Sheets(1)

Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column

For i = lastRow To 1
    If Cells(i, "B").Value <> "" Then


End Sub
2
vbaexcel

2 Answers

1
votes

without making major changes to your code, try this:

For i = lastRow To 1 Step - 1
    If Cells(i, "B").Value <> "" Then
    Range(Cells(i, "B").Offset(1), Cells(i, "B").Offset(2)).EntireRow.Delete  'delete two below
    Cells(i, "B").Offset(-1).EntireRow.Delete ' delete one above

You already get to your non-blank cell (ie Cells(i,"b")). To reference a range in relation to a cell you already have, use OFFSET.

So, and in this order, you select a range of cells from one below your cell Offset(1) to two cells below Offset(2)'. Change this range toENTIREROW` for those cells, and delete.

Then you select the cell above Offset(-1), select the ENTIREROW and delete.

0
votes

as per your question narrative you'd possibly need to delete all rows that has a blank cell in column "B"

should that be the issue than you could (disclaimer: test it on a copy sheet!) simply go like follows:

Sub test()    
    With ActiveWorkbook.Sheets(1)
        .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
End Sub