CODEWITHSUNDEEP
vbaexcel
Jalkey
Jalkey

Reputation: 15

Excel VBA: Code To Delete Row IF Blank Cell; Optimization

Essentially, when running the below code within one workbook (1 sheet) it completes within an instant. But when using it in my main workbook (couple of sheets, barely any data) it takes a while to complete. How can I optimize the below code?

Sub DeleteBlankRows()
    On Error Resume Next
    Sheets("Sheet4").Activate
    Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Upvotes: 1

Views: 127

Answers (3)

Orin
Orin

Reputation: 1

   lastRow = .Cells(Rows.Count, 4).End(xlUp).row

I never use this method for figuring out last row. It takes too long... Basically processing every cell starting from the bottom of the worksheet. Instead, I count the number of cells with values. I use that number to run a for loop which tests to see if there is a value in a given cell and counts until all cells with values are accounted for. Code wise, its more complicated... but in my experience executes more quickly. 

kount = Application.WorksheetFunction.CountA(krng) 'Count how many used cells there are

kRow = 1
j = 1

Do Until j = kount + 1 'Do until all used cells are acounted for

If Cells(kRow, l).Value = vbNullString Then 'If current cell is empty skip it
    Else
    j = j + 1 'If the current cell has a value count up
    End If
    kRow = kRow + 1 'but go on to the next row either way
Loop

Where kRow is the last row with a value

Upvotes: -2

Luis Curado
Luis Curado

Reputation: 756

you could try too to stop the automatic calculation and screen update and at the end reenable all.

try this and test too with the other codes

Sub DeleteBlankRows()
   Application.ScreenUpdating = False
   Application.Calculation = xlManual

   On Error Resume Next
   Sheets("Sheet4").Activate
   Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

   Application.ScreenUpdating = true
   Application.Calculation = xlAutomatic
End Sub

Good Luck

Upvotes: 0

BruceWayne
BruceWayne

Reputation: 23283

Try avoiding the use of an entire column, as well as .Activate:

Sub DeleteBlankRows()
   ' On Error Resume Next
    Dim lastRow As Long
    With Sheets("Sheet4")
        lastRow = .Cells(Rows.Count, 4).End(xlUp).row
        .Range(.Cells(1, 4), .Cells(lastRow, 4)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
End Sub

Edit: Commented out the On Error Resume Next

Upvotes: 3

Related Questions