CODEWITHSUNDEEP
vbaexcel
Alex
Alex

Reputation: 127

Delete rows over multiple worksheets in Excel if cell value equals "blank"

I want to delete rows over multiple worksheets (only specific ones within the workbook) if a cell value is blank. Note, the rest of the fields in the row do contain data. So far I have the below however unsure how to specify the worksheets. Can anyone help?

  Sub sbDelete_rows_if_cell_blank()
    Dim lRow As Long
    Dim iCntr As Long
        lRow = 2000
        For iCntr = lRow To 1 Step -1
        If Cells(iCntr, 1).Value = "" Then
            Rows(iCntr).Delete
        End If
    Next
    End Sub

Upvotes: 1

Views: 6000

Answers (2)

Tom
Tom

Reputation: 9878

Putting your code inside this loop will loop through all the worksheets in the Workbook that this code is inside and run your code in each.

Sub sbDelete_rows_if_cell_blank()
    Dim lRow As Long
    Dim iCntr As Long
    Dim ws as Worksheet

    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 ws.name<>"Sheet1" and ws.name <> "Sheet2" then ' change this line to the sheet names you want to leave out. 
             If IsEmpty(ws.Cells(iCntr, 1)) Or Trim(ws.Cells(iCntr, 1).Value) = "" Then
                ws.Rows(iCntr).Delete
            End If
           end if 
        Next iCntr
    Next ws
End Sub

Updated with D_Bester's suggestion for if condition

Update 2: See Comments

This will do what I think you want to achieve

Sub Combine()
    Dim nws, ws As Worksheet
    Dim rng As Range

    ' Add New Sheet
    On Error Resume Next
    Set nws = ThisWorkbook.Sheets("Combined")
    If nws Is Nothing Then
        With ThisWorkbook.Sheets
            Set nws = .Add(After:=Sheets(.Count))
            nws.Name = "Combined"
        End With
    End If
    On Error GoTo 0

    For Each ws In ThisWorkbook.Sheets
        If Not ws.Name = nws.Name Then
            With ws
                Set rng = Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
                rng.Copy Destination:=nws.Cells(nws.Cells(nws.Rows.Count, "A").End(xlUp).Row + 1, 1)
            End With
        End If
    Next ws
End Sub

Upvotes: 3

Davesexcel
Davesexcel

Reputation: 6984

You can loop through the sheets, then use specialcells to delete the blanks. Yoi can also set the loop so it doesn't delete the blanks in "Sheet1"(in this example)

Sub DeleteBlnkRows()
    Dim sh As Worksheet

    For Each sh In Sheets
        If sh.Name <> "Sheet1" Then
            sh.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        End If
    Next sh

End Sub

Upvotes: 1

Related Questions