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
– Olly, Commented May 16, 2018 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
– CLR, Commented May 16, 2018 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. — TurboCoder
– TurboCoder, Commented May 16, 2018 at 12:42
So when you step through the code, what value does lRow have? — Olly
– Olly, Commented May 16, 2018 at 14:52

SJR · Accepted Answer · 2018-05-16 16:42:57Z

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, 2018 at 16:42

answered May 16, 2018 at 10:15

SJR

23.1k6 gold badges21 silver badges26 bronze badges

Sign up to request clarification or add additional context in comments.

11 Comments

TurboCoder Over a year ago

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?

SJR Over a year ago

Just try the second method as you have quite a lot of data. Have you stepped through - what is the value of lRow?

SJR Over a year ago

I've made a few changes above so let me know how you get on.

CLR Over a year ago

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.

TurboCoder Over a year ago

@CLR Thank you for the reply.. I did try to do what you suggested, but it did not work.. Program becomes unresponsive..

|

Collectives™ on Stack Overflow

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

1 Answer 1

11 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

11 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related