VBA - Delete Blank Rows in Column B - Stuck in Infinite Loop

Question

I have the code below which deletes the blank rows in column A for all worksheets in the workbook - and it works well.

Code:

Option Explicit

Sub DeleteBlankRows()

    Dim lRow As Long
    Dim iCntr As Long
    Dim ws As Worksheet
    Dim wkbk1 As Workbook

    Set wkbk1 = Workbooks("test.xlsm")

    wkbk1.Activate

    For Each ws In ThisWorkbook.Worksheets

        ' Find last row in column A
        lRow = ws.Range("A" & ws.Rows.count).End(xlUp).Row

        For iCntr = lRow To 1 Step -1

            If IsEmpty(ws.Cells(iCntr, 1)) Or Trim(ws.Cells(iCntr, 1).Value) = "" Then

                ws.Rows(iCntr).Delete

            End If

        Next iCntr

    Next ws

End Sub

When I modify this code for a different purpose - to delete the blank rows in column B of a specific worksheet, then it just gets stuck in a loop and it did not delete a single row.

Option Explicit

Sub DeleteBlankRows()

    Dim lRow As Long
    Dim iCntr As Long
    Dim ws As Worksheet
    Dim wkbk1 As Workbook

    Set wkbk1 = Workbooks("test.xlsm")
    Set ws = wkbk1.Worksheets("sheet1")

    wkbk1.Activate
    ws.Activate

    With ws

        ' Find last row in column A
        lRow = ws.Range("B" & ws.Rows.count).End(xlUp).Row

        For iCntr = lRow To 1 Step -1

            If IsEmpty(ws.Cells(iCntr, 1)) Or Trim(ws.Cells(iCntr, 2).Value) = "" Then

                ws.Rows(iCntr).Delete

            End If

        Next iCntr

    End With

End Sub

I basically need help to let the code execute without getting stuck in a loop and to delete the blank rows found in column B on sheet1.

UPDATE:

I have uploaded a sample file to Google Drive if anyone would like to test on the file itself.

https://drive.google.com/file/d/1ImIqiA0znynSXAyZnUtpCG8mRIFlnXAl/view?usp=sharing

Do yoiu have any non blank values in Column B? When you step through the code, what value is being assigned to lRow? — Olly, May 16 '18 at 10:15
Not sure why you think the above causes an infinite loop - unless your column B has some data near the very bottom of the sheet and you just ran out of patience before it got to the top.. — CLR, May 16 '18 at 10:18
@CLR I am assuming its an infinite loop because the macro does not stop. I let it run for about 10 minutes and nothing happened. — Eitel Dagnin, May 16 '18 at 12:42
So when you step through the code, what value does lRow have? — Olly, May 16 '18 at 14:52

SJR · Accepted Answer · 2018-05-16T16:42:57.733

1

You were still referencing column 1 in your first check (which is possibly redundant anyway). I have suggested an alternative approach to deleting rows which is more efficient (Autofilter is another option).

Sub DeleteBlankRows()

Dim lRow As Long, iCntr As Long, ws As Worksheet, wkbk1 As Workbook, r As Range

Set wkbk1 = Workbooks("SampleBook.xlsm")
Set ws = wkbk1.Worksheets("HR")

Application.ScreenUpdating = False

With ws
    .AutoFilterMode = False
    .Range("A1").AutoFilter Field:=2, Criteria1:="="
    With .AutoFilter.Range
        On Error Resume Next
        Set r = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not r Is Nothing Then
            r.EntireRow.Delete shift:=xlUp
        End If
    End With
    .AutoFilterMode = False
End With

'With ws
'    lRow = .Range("B" & ws.Rows.Count).End(xlUp).Row
'    For iCntr = lRow To 1 Step -1
'        If Trim(.Cells(iCntr, 2).Value) = "" Then
'            If r Is Nothing Then
'                Set r = .Cells(iCntr, 2)
'            Else
'                Set r = Union(r, .Cells(iCntr, 2))
'            End If
'        End If
'    Next iCntr
'End With
'If Not r Is Nothing Then r.EntireRow.Delete shift:=xlUp

Application.ScreenUpdating = True

End Sub

edited May 16 '18 at 16:42

answered May 16 '18 at 10:15

SJR

22,986
6
18
26

Thank you for your reply SJR. Unfortunately both solutions do not seem to be working. The first one just runs and does not stop, the second one causes excel to not respond and I need to force close it. Perhaps its worth mentioning that there are 8000 rows in the sheet? – Eitel Dagnin May 16 '18 at 12:51
Just try the second method as you have quite a lot of data. Have you stepped through - what is the value of lRow? – SJR May 16 '18 at 13:38
I've made a few changes above so let me know how you get on. – SJR May 16 '18 at 13:40
Maybe add the line `If iCntr Mod 50 = 0 Then Application.Statusbar = "Row : " & iCntr` as the first line inside the `For... Next` loop to see where in the spreadsheet it is? If you do, reset `Application.Statusbar = False` before Ending the Sub. – CLR May 16 '18 at 13:53
@CLR Thank you for the reply.. I did try to do what you suggested, but it did not work.. Program becomes unresponsive.. – Eitel Dagnin May 16 '18 at 15:40
SJR - I tried again, and still the same thing happens.. Also, I need to correct my previous statement about the amount of of rows that there are.. Its actually quite a lot more - 99977 is the correct amount. If you will, please refer to the bottom of my post, I have updated it. – Eitel Dagnin May 16 '18 at 15:42
You might want to change the `If` into an `If` and `End If` with the `StatusBar` line between them but also a `DoEvents` to ensure the status bar is updated..? – CLR May 16 '18 at 15:45
How long did you wait? Have you stepped through? Does the status bar show anything? – SJR May 16 '18 at 16:11
You might want to consult this question https://stackoverflow.com/questions/30959315/excel-vba-performance-1-million-rows-delete-rows-containing-a-value-in-less Do you have any other code in the file? – SJR May 16 '18 at 16:13
OK now there is another method above which I ran on your file. It's not quick - it took about 35 seconds but did the job. The original code was also interminably slow for me. – SJR May 16 '18 at 16:43
Okay, we are making progress! :) SJR, thank you, the latest solution does work 100%, but it is slow like you said, BUT again, its nearly 100 000 lines soooo yeah.. Also I did step through the code on the previous solution, it completely skips over the If Trim(.Cells(iCntr, 2).Value) = "" Then statement and goes straight to End If. I will mark this solution as correct, but if you can perhaps figure out why the if statement is skipped and I can test that too, it would be appreciated :) – Eitel Dagnin May 17 '18 at 08:11

VBA - Delete Blank Rows in Column B - Stuck in Infinite Loop

1 Answers1