Delete Empty Rows Quickly Looping though all workbooks in Folder

Question

I have more than 200 workbooks in an Folder, and i deletes the empty rows by giving an Range in the code that is Set rng = sht.Range("C3:C50000").

If Column C any cell is empty then delete entire Row. Day by day data is enhancing and below code took nearly half hour to complete the processing. That time limit is also increasing with the data.

I am looking for a way to to do this in couple of minutes or in less time. I hope to get some help.

Sub Doit()
    Dim xFd         As FileDialog
    Dim xFdItem     As String
    Dim xFileName   As String
    Dim wbk         As Workbook
    Dim sht         As Worksheet
    
    Application.ScreenUpdating = FALSE
    Application.DisplayAlerts = FALSE
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    Else
        Beep
        Exit Sub
    End If
    xFileName = Dir(xFdItem & "*.xlsx")
    Do While xFileName <> ""
        Set wbk = Workbooks.Open(xFdItem & xFileName)
        For Each sht In wbk.Sheets
            
            Dim rng As Range
            Dim i   As Long
            Set rng = sht.Range("C3:C5000")
            With rng
                'Loop through all cells of the range
                'Loop backwards, hence the "Step -1"
                For i = .Rows.Count To 1 Step -1
                    If .Item(i) = "" Then
                        'Since cell Is empty, delete the whole row
                        .Item(i).EntireRow.Delete
                    End If
                Next i
            End With
    
        Next sht
        wbk.Close SaveChanges:=True
        xFileName = Dir
    Loop

    Application.ScreenUpdating = TRUE
    Application.DisplayAlerts = TRUE
End Sub

`sht.Range("C3:C5000").specialcells(xlcelltypeblanks).entirerow.delete` would be a faster way to remove the rows. — Tim Williams, Oct 07 '21 at 15:29
I tried using your way it gives an error `Object required` on this line `sht.Range("C3:C5000").specialcells(xlcelltypeblanks).entirerow.delete` — , Oct 07 '21 at 15:40
fastest way is not to loop at all. Sort your data so all blanks are together and delete the whole blank section. — sous2817, Oct 07 '21 at 15:42
As always with deleting, its faster to collect the range into a single object and then delete it all at once. This way the application doesn't need to refresh & recalculate after each deleted row. Even if you turn calculation to manual, the application needs to apply new addresses to all the data that was shifted by the delete. Use `Union` to save the rows into a single range, and then `Range.Delete` at the end, after the loop. — Toddleson, Oct 07 '21 at 15:43
Also, to make this even more painless on the user, you can have the workbook open in a hidden window, so the user isnt bothered by workbooks popping open and closed. I've also noticed that it opens faster when the application knows that it will open hidden. [Here](https://stackoverflow.com/a/579846/14608750)'s a great example of how to do it. — Toddleson, Oct 07 '21 at 15:49
In the end, opening and saving 200+ (large) files (presumably via network) will always take time ... maybe it's worth reviewing the process itself ... — Ike, Oct 07 '21 at 15:52
I read your comments regarding how to make the function fast @Toddleson but i am not an expert but beginner to Excel VBA. I got multiple examples through Google but its hard to apply on above code. — , Oct 07 '21 at 15:59
The question mentions 50k `C3:C50000` but the code uses 5k `sht.Range("C3:C5000")`. Is that 5,000 a estimate of the largest one ? could some have a lot less ? — CDP1802, Oct 07 '21 at 16:46
@CDP1802 Oh good catch, this code would probably benefit greatly from a dynamic search range. defining the search range with `UsedRange` or [LastRow](https://stackoverflow.com/a/11169920/14608750) could shorten the search and delete loops to the actual size of the data, minimizing time spent per file. — Toddleson, Oct 07 '21 at 17:09
To do this in "a couple of minutes" you're asking to process (open, delete rows, save, close) each file in less than a second. It would be useful to know the relative time taken for each of those steps — chris neilsen, Oct 07 '21 at 18:39

Toddleson · Answer 1 · 2021-10-08T13:27:22.467

This is how I would implement my suggestions of

collecting the rows to delete into a single range and deleting after the loop.
opening the workbooks in a hidden window so the user is not disturbed by files opening and closing. (And also a minor speed boost when opening files)
Dynamically defining your search range to fit the data of each file, eliminating wasted time searching blank ranges.

Sub Doit()
    Dim xFd         As FileDialog
    Dim xFdItem     As String
    Dim xFileName   As String
    Dim wbk         As Workbook
    Dim sht         As Worksheet
    Dim xlApp       As Object
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    Else
        Beep
        Exit Sub
    End If
    xFileName = Dir(xFdItem & "*.xlsx")
    Set xlApp = CreateObject("Excel.Application." & CLng(Application.Version))
    
    Do While xFileName <> ""
        Set wbk = xlApp.Workbooks.Open(xFdItem & xFileName)
        For Each sht In wbk.Sheets
            
            Dim rng As Range
            Dim rngToDelete As Range
            Dim i   As Long
            Dim LastRow as Long
            LastRow = sht.Cells.Find("*", SearchDirection:=xlPrevious).Row
            Set rng = sht.Range("C3:C" & LastRow)
            With rng
                'Loop through all cells of the range
                'Loop backwards, hence the "Step -1"
                For i = .Rows.Count To 1 Step -1
                    If .Item(i) = "" Then
                        'Since cell Is empty, delete the whole row
                        If rngToDelete Is Nothing Then
                            Set rngToDelete = .Item(i)
                        Else
                            Set rngToDelte = Union(rngToDelete, .Item(i))
                        End If
                    End If
                Next i
            End With
            If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
        Next sht
        wbk.Close SaveChanges:=True
        xFileName = Dir
    Loop
    xlApp.Quit
    Set xlApp = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

I use CreateObject to create a new excel app, and I use Application.Version so the new excel app is the same as the current one. I have had bad experience using New Excel.Application to create the object because it sometimes gets redirected to an excel 365 demo, or some other version of excel that is installed on the computer but not intended for use.

I've never really tested the speed difference between opening in app or in a second hidden app. I ran a test (repeatedly opening and closing the same blank excel file) and found that even with `ScreenUpdating = False` the second hidden app was faster. `0.2558` seconds to open a workbook in app, and `0.1560` seconds to open in the hidden app. Without `ScreenUpdating =False`, the hidden window retained its speed but the regular app went up to `0.3697` seconds to open the file. — Toddleson, Oct 07 '21 at 17:01
Side note: Building a range of non-contiguous sub ranges using Union does not scale well. The time taken to add another range using Union increases exponentially as the number of non-contiguous sub ranges in the range increases. Up to about 1000 sub ranges this won't be noticable. Once you get to 10's or 100's of thousands the slowdown is significant — chris neilsen, Oct 07 '21 at 18:31
Thank you but i have an error when i initiated the code https://imgur.com/SwZ9qFk — , Oct 08 '21 at 11:15
@ShRa sorry, It's supposed to say sht.Cells.Find, I'll correct it. — Toddleson, Oct 08 '21 at 13:27

score 0 · Accepted Answer · answered Oct 07 '21 at 16:22

Try this for quicker row deletion:

Sub Doit()
    Dim xFd         As FileDialog
    Dim xFdItem     As String
    Dim xFileName   As String
    Dim wbk         As Workbook
    Dim sht         As Worksheet
    
    Application.ScreenUpdating = FALSE
    Application.DisplayAlerts = FALSE
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    Else
        Beep
        Exit Sub
    End If
    
    xFileName = Dir(xFdItem & "*.xlsx")
    Do While xFileName <> ""
        Set wbk = Workbooks.Open(xFdItem & xFileName)
        For Each sht In wbk.WorkSheets 'Sheets includes chart sheets... 
            On Error Resume Next  'in case of no blanks  
            sht.Range("C3:C5000").specialcells(xlcelltypeblanks).entirerow.delete
            On Error Goto 0
        Next sht
        wbk.Close SaveChanges:=True
        xFileName = Dir()
    Loop

    Application.ScreenUpdating = TRUE
    Application.DisplayAlerts = TRUE
End Sub

Note though your biggest time sink may still be opening and saving/closing all the files.

Thank you @Tim Williams it works perfect. It is much faster than i ever think. — , Oct 08 '21 at 11:12

score 0 · Answer 3 · answered Oct 07 '21 at 19:18

Reference Filtered Column

The Function

Option Explicit

Function RefFilteredColumn( _
    ByVal ColumnRange As Range, _
    ByVal Criteria As String) _
As Range
    Const ProcName As String = "RefFilteredColumn"
    On Error GoTo ClearError
    
    Dim ws As Worksheet: Set ws = ColumnRange.Worksheet
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
    
    Dim crg As Range: Set crg = ColumnRange.Columns(1)
    Dim cdrg As Range: Set cdrg = crg.Resize(crg.Rows.Count - 1).Offset(1)
    
    crg.AutoFilter 1, Criteria, xlFilterValues
    
    On Error Resume Next
    Set RefFilteredColumn = cdrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo ClearError
    
    ws.AutoFilterMode = False
    
ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function

Use in Your Code

    For Each sht In wbk.Worksheets
        ' The header row ('C2', not 'C3') is needed when using 'AutoFilter'.
        Dim rng As Range: Set rng = sht.Range("C2:C5000")
        Dim frg As Range: Set frg = RefFilteredColumn(rng, "")
        If Not frg Is Nothing Then
            frg.EntireRow.Delete
            Set frg = Nothing
        ' Else ' no blanks
        End If
    Next sht

Thank you very much its working perfect. – Oct 08 '21 at 11:13 — , Oct 08 '21 at 11:13

Delete Empty Rows Quickly Looping though all workbooks in Folder

3 Answers3

Reference Filtered Column