Delete all rows in Excel workbook with column C empty using VBA

user_16722581 0
Viewed 101

I am working on a project to clean up a couple hundred excel sheets for an specific import spec. The import process errors out if any rows have a specific value blank, so I'm looking to find the best way to delete all rows in the entire workbook if column C in that row is empty. I found this simple VBA code that works on the active sheet, but I need it to loop through all sheets in the workbook. Any suggestions on a better process so I don't have to run it >100 times?

Sub DelBlankRows()
    Columns("C:C").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
End Sub
vba excel
3 Answers

Delete the Rows of a Column's Blanks

Option Explicit

Sub DelRowsOfColumnBlanksTEST()
    
    Const wsCol As Variant = "C" ' or 3
    'Const wsCol As String = "C"
    'Const wsCol As Long = 3
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        DelRowsOfColumnBlanks ws, wsCol
    Next ws

    Application.ScreenUpdating = True

End Sub

Sub DelRowsOfColumnBlanks( _
        ByVal ws As Worksheet, _
        ByVal WorksheetColumnID As Variant)
    
    If ws Is Nothing Then Exit Sub ' no worksheet
        
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
    
    Dim urg As Range: Set urg = ws.UsedRange
    If urg.Rows.Count = 1 Then Exit Sub ' only one row
    
    On Error Resume Next
    Dim crg As Range: Set crg = ws.Columns(WorksheetColumnID)
    On Error GoTo 0
    If crg Is Nothing Then Exit Sub ' invalid Worksheet Column ID
    
    Dim tcrg As Range: Set tcrg = Intersect(urg, crg)
    ' ... is only the same as 'Set tcrg = urg.Columns(WorkhseetColumnID)',...
    ' ... if the first column of the used range is column 'A'.
    If tcrg Is Nothing Then Exit Sub ' no intersection
    
    Dim drg As Range: Set drg = tcrg.Resize(tcrg.Rows.Count - 1).Offset(1)
                                                                                                                                                                        
    tcrg.AutoFilter 1, "=" ' ... covers blanks: 'Empty', "=""""", "'"... etc.
    
    ' Note that although it contains the word 'Blanks',...
    ' ... 'SpecialCells(xlCellTypeBlanks)' only covers 'Empty'.
    
    On Error Resume Next
    Dim spcrg As Range: Set spcrg = drg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not spcrg Is Nothing Then
        spcrg.EntireRow.Delete
    'Else
        ' no 'visible' cells (to delete)
    End If
    
    ws.AutoFilterMode = False
    
End Sub
user_98140690 
Option Explicit

Sub CleanWorkbook()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim sh As Worksheet
    For Each sh In ActiveWorkbook.Worksheets
        DeleteRowsOfEmptyColumn sh, "C"
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub DeleteRowsOfEmptyColumn(sh As Worksheet, col as string)
    Dim rowsToDelete As New Collection
    Dim cell
    For Each cell In Intersect(sh.UsedRange, sh.Columns(col))
        If cell.Value = "" Then
            rowsToDelete.Add cell.Row
        End If
    Next
    
    Dim i As Integer
    For i = rowsToDelete.Count To 1 Step -1
        sh.Rows(rowsToDelete(i)).Delete
    Next
End Sub
user_59188510

I've put a very basic error trap for any sheets with no values in C. You may need to improve this yourself.

Edit: Updated error trap

    Sub DelBlankRows()
    
    Dim sh As Worksheet

    Application.ScreenUpdating = False
    
    On Error GoTo Handle
    For Each sh In ThisWorkbook.Worksheets
        sh.Activate
        Columns("C:C").Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.EntireRow.Delete
Cont:
    Next sh
    
    Application.ScreenUpdating = True
   
    Exit Sub

Handle:
    If Err.Number = 1004 Then Resume Cont
    
End Sub
user_113905750
Related