how to suppress efficiently all empty rows in selected columns in excel vba?-CodePudding

I have found some Q/A to delete rows with empty cells in a chosen column like here. My need is a bit different, the columns are selected by the user and I delete the rows where all the cells are empty for these columns, but this is not important.

The following code is working, but can only process 1,000 lines per minute on my i5. In my use case, the datasheet contains several 100k lines which means hours to process. This is not acceptable. Is there a trick to perfom it quickly please?

Sub DeleteRowsOfEmptyColumn() 'sh As Worksheet, col As String)
    Application.ScreenUpdating = False
    Dim sh As Excel.Worksheet: Set sh = ActiveWorkbook.ActiveSheet
    Dim col As Range: Set col = Selection.EntireColumn
    Dim cell
    Dim area As Range: Set area = Intersect(sh.UsedRange, col)
    For i = area.Rows.Count To 1 Step -1 'For Each row In area.Rows
        fKeep = False
        For Each cell In area.Rows(i).Cells
            If Not IsEmpty(cell) Then
                fKeep = True
                Exit For
            End If
        Next cell
        If Not fKeep Then
            sh.Rows(i).Delete 'rowsToDelete.Add i
        End If
    Next i  
    Application.ScreenUpdating = True
End Sub

CodePudding user response：

Delete Empty Row Ranges

This is a basic example. Your feedback regarding the efficiency is appreciated.

Option Explicit

Sub DeleteRowsOfEmptyColumn()
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    Dim crg As Range: Set crg = Selection.EntireColumn ' Columns Range
    Dim srg As Range: Set srg = Intersect(ws.UsedRange, crg) ' Source Range
    
    Dim drg As Range ' Delete Range
    Dim arg As Range ' Area Range
    Dim rrg As Range ' Row Range
    
    For Each arg In srg.Areas
        For Each rrg In arg.Rows
            If Application.CountA(rrg) = 0 Then
                If drg Is Nothing Then
                    Set drg = rrg
                Else
                    Set drg = Union(drg, rrg)
                End If
            End If
        Next rrg
    Next arg
    
    If Not drg Is Nothing Then drg.Delete
    
    Application.ScreenUpdating = True

    MsgBox "Rows deleted.", vbInformation

End Sub

CodePudding user response：

I am working on similar kind of project. I have chosen to read the data into an array, and then work with the data in the array which improves run time significantly. Here is a copy of the function that I have used to delete / transform the data set:

    Option Explicit
Option Base 1
Public Function RemoveRowFromArray(Arr As Variant, Element As String, Col As Long) As Variant

Dim i, j, c, count As Long
Dim TempArr() As Variant

    For i = LBound(Arr, 1) To UBound(Arr, 1)                         ' looping through the columns to get desired value
        If Arr(i, Col) = Element Then
             count = count   1                                                   ' Counting the number of Elements in array / matrix
                    For j = i To (UBound(Arr, 1) - 1)                       ' Looping from the row where Element is found
                        For c = LBound(Arr, 2) To UBound(Arr, 2)    ' Moving all elements in row 1 row up
                                Arr(j, c) = Arr(j   1, c)
                        Next c
                    Next j
        End If
    Next i
    
    ' Populating TempArr to delete the last rows

ReDim TempArr((UBound(Arr, 1) - count), UBound(Arr, 2))

   For i = LBound(TempArr, 1) To UBound(TempArr, 1)
            For j = LBound(TempArr, 2) To UBound(TempArr, 2)
                    TempArr(i, j) = Arr(i, j)                                                 
            Next j
    Next i

    RemoveRowFromArray = TempArr
End Function

I tested this and seems to work perfectly. A few important matters to keep in mind

Option Base 1 - This is important, when you declare an arr in VBA it starts at Index 0, when you read the arr from a data set in Excel [arr = sheet1.Range("A:D")] then the arr starting index is 1, Option Base 1 will ensure that all arr start at Index 1.

The function variables are : Arr - the array / matrix

Element - the string that you wish to search for (in your case it would be blank)

Col - is the column number in which Element is.

CodePudding user response：

Please, try the next way:

Sub DeleteRowsOfEmptyColumn()
    Dim sh As Excel.Worksheet: Set sh = ActiveSheet
    Dim col As Range: Set col = Selection.EntireColumn
    Dim area As Range: Set area = Intersect(sh.UsedRange, col)
    Dim areaV As Range
    On Error Resume Next
        Set areaV = area.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not areaV Is Nothing Then areaV.EntireRow.Delete   
End Sub