Delete Blank Rows and Columns with huge set of data

[Niranjanrajrishi]

LastRow = ActiveSheet.UsedRange.Row - 1 + _
    ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
    If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

LastColumn = ActiveSheet.UsedRange.Column - 1 + _
    ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
For C = LastColumn To 1 Step -1
    If Application.CountA(Columns(C)) = 0 Then Columns(C).Delete
Next C

Hi,

I am trying to delete blank rows and columns with the attached coding. But it takes huge time to delete the data. Is there a better way to delete blank rows and columns? The file sometime has 2 mil data.

 

[Hui]

Can you please try this which I modified from Stackoverflow

Sub DeleteBlankRows()

Dim wks As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
    lngColCounter As Long
Dim blnAllBlank As Boolean
Dim UserInputSheet As String

UserInputSheet = "sheet1"
'Application.InputBox("Enter the name of the sheet which you wish to remove empty rows from")

Set wks = Worksheets(UserInputSheet)

With wks
    'Now that our sheet is defined, we'll find the last row and last column
    lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious).Row
    lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious).Column

    'Since we need to delete rows, we start from the bottom and move up
    For lngIdx = lngLastRow To 1 Step -1

        'Start by setting a flag to immediately stop checking
        'if a cell is NOT blank and initializing the column counter
        blnAllBlank = True
        lngColCounter = 2

        'Check cells from left to right while the flag is True
        'and the we are within the farthest-right column
        While blnAllBlank And lngColCounter <= lngLastCol

            'If the cell is NOT blank, trip the flag and exit the loop
            If .Cells(lngIdx, lngColCounter) <> "" Then
                blnAllBlank = False
            Else
                lngColCounter = lngColCounter + 1
            End If

        Wend

        'Delete the row if the blnBlank variable is True
        If blnAllBlank Then
            .Rows(lngIdx).Delete
        End If

    Next lngIdx

    For lngIdx = lngLastCol To 1 Step -1

        'Start by setting a flag to immediately stop checking
        'if a cell is NOT blank and initializing the column counter
        blnAllBlank = True
        lngColCounter = 2

        'Check cells from left to right while the flag is True
        'and the we are within the farthest-right column
        While blnAllBlank And lngColCounter <= lngLastCol

            'If the cell is NOT blank, trip the flag and exit the loop
            If .Cells(lngColCounter, lngIdx) <> "" Then
                blnAllBlank = False
            Else
                lngColCounter = lngColCounter + 1
            End If

        Wend

        'Delete the row if the blnBlank variable is True
        If blnAllBlank Then
            .Columns(lngIdx).Delete
        End If

    Next lngIdx
End With



MsgBox "Blank Rows and Columns have been deleted."

End Sub

 

[Hui]

You may also wish to have a read of:
https://stackoverflow.com/questions...-containing-a-value-in-less/33192437#33192437

The solution by Excelhero looks like it was fastest

Note there are caveats as some of those solutions copy the whole page to a new worksheet uisng an Advanced Filter and obviously if you have formulas on the worksheet they will get messed up

 

[Marc L]

Hi !

Is there a better way to delete blank rows

Easy and fast way as shown in this forum is to not delete but to just sort !
​

 

[Niranjanrajrishi]

TH

Can you please try this which I modified from Stackoverflow

Sub DeleteBlankRows()

Dim wks As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
    lngColCounter As Long
Dim blnAllBlank As Boolean
Dim UserInputSheet As String

UserInputSheet = "sheet1"
'Application.InputBox("Enter the name of the sheet which you wish to remove empty rows from")

Set wks = Worksheets(UserInputSheet)

With wks
    'Now that our sheet is defined, we'll find the last row and last column
    lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious).Row
    lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious).Column

    'Since we need to delete rows, we start from the bottom and move up
    For lngIdx = lngLastRow To 1 Step -1

        'Start by setting a flag to immediately stop checking
        'if a cell is NOT blank and initializing the column counter
        blnAllBlank = True
        lngColCounter = 2

        'Check cells from left to right while the flag is True
        'and the we are within the farthest-right column
        While blnAllBlank And lngColCounter <= lngLastCol

            'If the cell is NOT blank, trip the flag and exit the loop
            If .Cells(lngIdx, lngColCounter) <> "" Then
                blnAllBlank = False
            Else
                lngColCounter = lngColCounter + 1
            End If

        Wend

        'Delete the row if the blnBlank variable is True
        If blnAllBlank Then
            .Rows(lngIdx).Delete
        End If

    Next lngIdx

    For lngIdx = lngLastCol To 1 Step -1

        'Start by setting a flag to immediately stop checking
        'if a cell is NOT blank and initializing the column counter
        blnAllBlank = True
        lngColCounter = 2

        'Check cells from left to right while the flag is True
        'and the we are within the farthest-right column
        While blnAllBlank And lngColCounter <= lngLastCol

            'If the cell is NOT blank, trip the flag and exit the loop
            If .Cells(lngColCounter, lngIdx) <> "" Then
                blnAllBlank = False
            Else
                lngColCounter = lngColCounter + 1
            End If

        Wend

        'Delete the row if the blnBlank variable is True
        If blnAllBlank Then
            .Columns(lngIdx).Delete
        End If

    Next lngIdx
End With



MsgBox "Blank Rows and Columns have been deleted."

End Sub

Thank you so much! It worked like a charm. The fastest coding ever used. thank you again.

Is there a way to add the status bar to identify the line item it is processing. it will help us to identify the progress.

 

[Marc L]

As Delete is slower than Clear after a sort ...​